AW: Nochmals Hilfe bei VBE nötig.
28.04.2006 15:28:32
Dan
Hi, hier ein Beispiel. Den Code in den Standard module kopieren und
Sub Main starten. Gruss Dan
Option Explicit
Private Const NUNBER_OF_LINES As Long = 3
Private Const STD_MODULE = 1
Public
Sub Main()
On Error GoTo Err_Main
Dim wrbNewWorkbook As Workbook ' this new workbook will be created from here
Dim vntNewModule As Variant ' the new workbook will contain this new code-module
Dim arrCodeLines(1 To NUNBER_OF_LINES) As String
Dim lngCodeLine As Long
' fill array with code-lines:
arrCodeLines(1) = "
Sub Test()"
arrCodeLines(2) = "MsgBox ""Hallo, test here!"""
arrCodeLines(3) = "End
Sub ' Test"
Set wrbNewWorkbook = AddNewWorkbook
Set vntNewModule = AddStandardModule(wrbNewWorkbook)
' write the code-lines to module:
For lngCodeLine = 1 To NUNBER_OF_LINES
InsertCodeLines vntNewModule, arrCodeLines(lngCodeLine)
Next lngCodeLine
Exit Sub
Err_Main:
MsgBox Err.Description, vbCritical, "Error in
Sub Main. [" & Err.Number & "]"
End Sub
Public
Function AddNewWorkbook(Optional ByVal i_strWorkbookName As String = "NewWorkbook") As Workbook
On Error GoTo Err_AddNewWorkbook
Set AddNewWorkbook = Excel.Workbooks.Add
AddNewWorkbook.SaveAs ThisWorkbook.Path & "\" & i_strWorkbookName
Exit Function
Err_AddNewWorkbook:
MsgBox Err.Description, vbCritical, "Error in
Function AddNewWorkbook. [" & Err.Number & "]"
End Function
Public
Function AddStandardModule(ByRef io_wrbTarget As Workbook, Optional ByVal i_strModuleName As String = "NewModule") As Variant
On Error GoTo Err_AddStandardModule
Set AddStandardModule = io_wrbTarget.VBProject.VBComponents.Add(STD_MODULE)
Exit Function
Err_AddStandardModule:
MsgBox Err.Description, vbCritical, "Error in
Function AddStandardModule. [" & Err.Number & "]"
End Function
Public
Sub InsertCodeLines(ByRef io_vntTarget As Variant, ByRef io_strLineOfCode As String)
On Error GoTo Err_InsertCodeLines
Dim lngInsertOnLine As Long
lngInsertOnLine = io_vntTarget.CodeModule.CountOfLines + 1
io_vntTarget.CodeModule.InsertLines lngInsertOnLine, io_strLineOfCode
Exit Sub
Err_InsertCodeLines:
MsgBox Err.Description, vbCritical, "Error in
Sub InsertCodeLines. [" & Err.Number & "]"
End Sub