AddFromString
04.07.2004 15:56:37
Kladeb
mit dem folgenden Code möchte ich ein Tabellenblatt in eine Arbeitsmappe einfügen. In dem neuem Blatt "Übersicht" soll für jedes bereits vorhandene Tabellenblatt ein Button erstellt werden. Das funktioniert auch so weit ganz gut, bloß das erstellen des Click-Makros klappt leider nicht ... Excel meckert Laufzeitfehler 1004.
Was mache ich da falsch?
Option Explicit
Private Sub Workbook_Open()
Dim loSheetZl As Object, loSheetX As Object, loButton As Object
Dim lbLöschen As Boolean
Dim lnTop As Integer, lnLeft As Integer
Dim lcCode As String, lcCodeZl As String
For Each loSheetZl In ThisWorkbook.Sheets
If loSheetZl.Name = "Übersicht" Then
lbLöschen = True
Exit For
End If
Next
If lbLöschen = True Then
Application.DisplayAlerts = False
loSheetZl.Delete
Application.DisplayAlerts = True
End If
Set loSheetZl = ThisWorkbook.Sheets.Add(Worksheets(1))
loSheetZl.Name = "Übersicht"
loSheetZl.Activate
ActiveWindow.DisplayGridlines = False
With loSheetZl.Cells.Interior
.ColorIndex = 49
.Pattern = xlSolid
End With
lnTop = 20
lnLeft = 20
For Each loSheetX In ThisWorkbook.Sheets
If Not (loSheetX.Name = loSheetZl.Name) Then
Set loButton = loSheetZl.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=lnLeft, Top:=lnTop, _
Width:=120, Height:=40)
lnTop = lnTop + 50
loButton.Object.WordWrap = True
loButton.Object.Caption = loSheetX.Name
lcCode = "
Private Sub " & loButton.Name & "_Click()" & vbLf
lcCode = lcCode & " MsgBox ""Hallo Welt!""" & vbLf
lcCode = lcCode & "End Sub
"
lcCodeZl = loSheetZl.CodeName
Debug.Print
ThisWorkbook.VBProject.VBComponents(lcCodeZl).CodeModule.AddFromString lcCode
If lnTop Mod 420 = 0 Then
lnTop = 20
lnLeft = lnLeft + 160
End If
End If
Next
loSheetZl.Range("A1").Select
End Sub
Gruss aus Hannover