Dynamisch einen Code erstellen,
falls dieser noch nicht vorhanden ist.
In diesem Beispiel wird unter "DieseArbeitsmappe"
die Sub "Auto_Open"
mit einer MsgBox-Anweisung erzeugt:
Const Ziel = "DieseArbeitsmappe"
Const SubName = "Auto_Open"
Private Function Existiert_Sub(SubName) As Boolean
SubName = UCase("Sub " & SubName & "()")
Existiert_Sub = False
For Each Linie In ThisWorkbook.VBProject.VBComponents
If Linie.Name = Ziel Then
With Linie.CodeModule
For i = 1 To .CountOfLines
If UCase(.Lines(i, 1)) = SubName Then
Existiert_Sub = True
Exit Function
End If
Next i
End With
End If
Next Linie
End Function
Sub Sub_anlegen()
If Not Existiert_Sub(SubName) Then
Set VBP = ActiveWorkbook.VBProject.VBComponents(Ziel)
With VBP.CodeModule
.InsertLines 1, "Sub " & SubName & "()"
.InsertLines 2, " Msgbox ""Hallo !"""
.InsertLines 3, "End Sub"
End With
MsgBox "Sub " & SubName & " wurde in " & Ziel & " angelegt !"
Else
MsgBox "Sub ist bereits vorhanden !", vbExclamation
End If
End Sub
|