Sub erzeugen, falls noch nicht vorhanden

13.05.2001


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
 
 
Download - 14 KB