Excel create copy.
-
I have SQL 2000 DTS that populates a complicated Excel worksheet. Because of macros and addon library, security is set to medium for current users. This sheet is now to be emailed to other corporate individuals. I would have to have them 1st set security to medium to allow the macro, and then be sure addon is available. Not going to happen.
Can I via DTS , after saving the sheet, open it, run macros for calculations, then just copy the sheet values & formats only off onto a new workbook worksheet, so it really becomes the final 'picture'?
thnx.
-
Try Something like this as an ActiveX task
Function Main()
dim xl_app
dim xl_Spreadsheet
set xl_app = CREATEOBJECT("Excel.Application")
set xl_Spreadsheet = xl_app.Workbooks.Open ("C:\book1.xls")
xl_app.run "Thisworkbook.RunMe" ' Macro Name to be run
xl_Spreadsheet.Save
xl_Spreadsheet.Close
xl_app.quit
set xl_app = Nothing
Main = DTSTaskExecResult_Success
End Function
Make sure that you have fully qualified cell references in your macro though, like:
Sheets(1).Cells(i, 1).Value
-
The task - OpenExcel Template, populate various ranges, Save as Excel workbook, email.
The problem - When the receipients open the attachment they are first propmpted to enable the macros. If their security is set high, they won't be prompted. Also ThisWorkbook.Open() is where the functions run to reformat the lost formating from transformation.
I think I need to after transformation, open the book letting the ThisWorkbook.Open() function run without prompt, then save sheet1 as values and formats only to a new workbook to be emailed.
Sound right?
-
I should add -
The ONLY reason for the ThisWorkbook.Open() functions is to restore formating lost in the transformation.
For Each c In Worksheets("CENSUS").Range("integers").Cells
If Len(c.Value) > 0 Then c.Value = CInt(c.Value)
Next
For Each c In Worksheets("CENSUS").Range("decimals").Cells
If Len(c.Value) > 0 Then
c.Value = CDbl(c.Value)
c.Value = FormatNumber(c.Value, 2)
End If
Next
For Each c In Worksheets("REF").Range("Budget").Cells
If Len(c.Value) > 0 Then
c.Value = CDbl(c.Value)
c.Value = FormatNumber(c.Value, 2)
End If
Next
Sheet1 contains ranges of integers & decimals. Although the data inserted into template is of the right type, and font size set in template, for some reason it will break-down and reformats itself.
-
Okay, I think I've got it....
You'll need the ActiveX task to open the workbook that'll run the Workbook_Open Macro (you may need to change Macro security settings in Excel to allow changes to VB project - not sure on this):
Function Main()
dim xl_app
dim xl_Spreadsheet
set xl_app = CREATEOBJECT("Excel.Application")
' Open Current Workbook
set xl_Spreadsheet = xl_app.Workbooks.Open ("C:\book1.xls")
xl_Spreadsheet.Close
xl_app.quit
set xl_app = Nothing
Main = DTSTaskExecResult_Success
End Function
And then you'll need some extra code in the Workbook_Open macro to delete all of the lines in the VB module:
Add these lines to the end of your Workbook_Open macro
Dim sWorkbook As Workbook
Set sWorkbook = Application.ActiveWorkbook
DeleteModuleContent sWorkbook, "ThisWorkbook"
Me.SaveAs "c:\book1(corporate_copy).xls"
' Wherever you want to save it
End Sub
Add this in to the same module and it will delete all of the lines in the module before saving the copy:
Sub DeleteModuleContent(ByVal wb As Workbook, _
ByVal DeleteModuleName As String)
On Error Resume Next
With wb.VBProject.VBComponents(DeleteModuleName).CodeModule
.DeleteLines 1, .CountOfLines
End With
On Error GoTo 0
End Sub
Let me know how you get on....
I can send you a sample workbook and DTS if you need one. -
stay tuned...
Viewing 6 posts - 1 through 5 (of 5 total)
You must be logged in to reply to this topic. Login to reply