[Excel] Code mit Code manipulieren...

[Case]

Hallo,  

immer mal wieder nachgefragt und es ist mir durchaus bewußt, dass dieses Thema sehr kontrovers diskutiert wird. In der Diskussion finden wir das gesamte Spektrum von "Himmelhoch jauchzend" bis hin zu "zu Tode betrübt". Und das Erstaunliche ist - jeder glaubt er habe recht.  

Dabei weiß doch jeder - nur ICH habe recht.

Ein Wort zur Sicherheit:
Makrosicherheit...

Zitat:
Zugriff auf das VBA-Projektobjektmodell vertrauen:
Diese Einstellung ist für Entwickler bestimmt und wird verwendet, um den programmgesteuerten Zugriff auf das VBA-Objektmodell von jedem beliebigen Automatisierungsclient aus absichtlich zu sperren oder zuzulassen. Mit anderen Worten: Die Einstellung bietet eine Sicherheitsoption für Code, der geschrieben wurde, um ein Office-Programm zu automatisieren sowie um die Microsoft VBA-Umgebung (Visual Basic für Applikationen) und das VBA-Objektmodell programmgesteuert zu bearbeiten. Auf diese benutzer- und anwendungsabhängige Einstellung kann standardmäßig nicht zugegriffen werden. Diese Sicherheitsoption erschwert es nicht autorisierten Programmen, "selbstreplizierenden" Code zu erstellen, der bei Endbenutzersystemen Schaden anrichten kann. Damit ein Automatisierungsclient programmgesteuert auf das VBA-Objektmodell zugreifen kann, muss ihm der den Code ausführende Benutzer explizit Zugriff gewähren. Aktivieren Sie das Kontrollkästchen, um den Zugriff zu aktivieren.

Nur wenn ihr das gelesen und verstanden habt - sonst funktioniert der Code nicht - könnt ihr loslegen.

OK - hier erstmal der Code:  

Code:

' Veröffentlicht auf CEF "https://www.clever-excel-forum.de/index.php" am 10.06.2023 von Case
' In der Rubrik Beispiele und Workshops unter mit VBA
Option Explicit
'Private Const vbext_pk_Get As Long = 3
'Private Const vbext_pk_Let As Long = 1
'Private Const vbext_pk_Set As Long = 2
'Private Const vbext_pk_Proc As Long = 0
' Wenn sie mit den Konstanten Texten (z. B. vbext_pk_Proc) arbeiten möchten, MÜSSEN sie entweder einen Verweis auf
' die "Microsoft Visual Basic for Applications Extensibility 5.3" setzen oder bei den obigen 4 Zeilen das Kommentarzeichen entfernen.
' Verweis im VBA-Editor unter "Extras - Verweise..." setzen.
' Wenn sie mit den Zahlwerten arbeiten ist der Verweis NICHT nötig.

' Hier wird in Tabelle3 (CodeName des Tabellenblattes) das Worksheet_Change gelöscht und aus
' einer Textdatei neu eingelesen. Das läuft auf einen Fehler, wenn kein Worksheet_Change vorhanden ist.
Public Sub Main_A()
    On Error GoTo Fin
    With ThisWorkbook.VBProject.VBComponents("Tabelle3").CodeModule
        .DeleteLines .ProcStartLine("Worksheet_Change", 0), .ProcCountLines("Worksheet_Change", 0)
        .AddFromFile (ThisWorkbook.Path & Application.PathSeparator & "VBA.txt")
    End With
Fin:
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
' Für den Test dieses Makros bitte die Datei "Beisp.xlsb" ÖFFNEN!!!!!!!!!!!!!!
' Hier wird in Tabelle3 (CodeName des Tabellenblattes) einer ANDEREN - aber geöffneten - Datei das Worksheet_Change
' gelöscht und aus einer Textdatei neu eingelesen. Der Fehler, wenn kein Worksheet_Change vorhanden ist, wird abgefangen.
Public Sub Main_B()
    On Error GoTo Fin
    With Workbooks("Beisp.xlsb").VBProject.VBComponents("Tabelle3").CodeModule
        On Error Resume Next
        .DeleteLines .ProcStartLine("Worksheet_Change", 0), .ProcCountLines("Worksheet_Change", 0)
        On Error GoTo Fin
        .AddFromFile (ThisWorkbook.Path & Application.PathSeparator & "VBA.txt")
    End With
Fin:
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
' Hier wird in Tabelle3 (CodeName des Tabellenblattes) in der Datei mit dem Makro ALLES gelöscht und dann neu geschrieben.
' Hier sieht man auch, dass Hochkommata, wenn sie innerhalb eines Stringes verwendet werden, GEDOPPELT werden müssen.
Public Sub Main_C()
    On Error GoTo Fin
    With ThisWorkbook.VBProject.VBComponents("Tabelle3").CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, "Option Explicit"
        .InsertLines 2, "Private Sub Worksheet_Change(ByVal Target As Range)"
        .InsertLines 3, "    MsgBox (""Klappt doch..."")"
        .InsertLines 4, "End Sub"
        .InsertLines 5, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
        .InsertLines 6, "    Beep"
        .InsertLines 7, "End Sub"
        .InsertLines 8, "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)"
        .InsertLines 9, "    MsgBox (""Einer geht noch..."")"
        .InsertLines 10, "End Sub"
    End With
Fin:
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
' Hier wird in Tabelle3 (CodeName des Tabellenblattes) in der Datei mit dem Makro ALLES gelöscht
' und dann über "CreateEventProc" und "InsertLines" neu geschrieben.
' Die "Events" werden alphabetisch und mit entsprechenden Leerzeilen angelegt.
' in "Public Sub Main_C()" bestimmen WIR die Reihenfolge und die Anzahl der Leerzeilen.
Public Sub Main_D()
    Dim lngLine As Long
    On Error GoTo Fin
    With ThisWorkbook.VBProject.VBComponents("Tabelle3").CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, "Option Explicit"
        lngLine = .CreateEventProc("Change", "Worksheet")
        .InsertLines lngLine + 1, "    MsgBox (""Klappt doch..."")"
        lngLine = .CreateEventProc("SelectionChange", "Worksheet")
        .InsertLines lngLine + 1, "    Beep"
        lngLine = .CreateEventProc("BeforeDoubleClick", "Worksheet")
        .InsertLines lngLine + 1, "    MsgBox(""Einer geht noch..."")"
    End With
Fin:
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
' Hier wird in den Tabelleblättern Tabelle1, Tabelle2 und Tabelle3 (CodeName der Tabellenblätter) in der Datei mit dem Makro ALLES gelöscht
' und dann neu geschrieben (in jedem Tabellenblatt).
Public Sub Main_E()
    Dim lngLine As Long
    Dim lngTMP As Long
    On Error GoTo Fin
    For lngTMP = 1 To 3
        With ThisWorkbook.VBProject.VBComponents("Tabelle" & lngTMP).CodeModule
            .DeleteLines 1, .CountOfLines
            .InsertLines 1, "Option Explicit"
            lngLine = .CreateEventProc("Change", "Worksheet")
            .InsertLines lngLine + 1, "    MsgBox (""Klappt doch..."")"
            lngLine = .CreateEventProc("SelectionChange", "Worksheet")
            .InsertLines lngLine + 1, "    Beep"
            lngLine = .CreateEventProc("BeforeDoubleClick", "Worksheet")
            .InsertLines lngLine + 1, "    MsgBox(""Einer geht noch..."")"
        End With
    Next lngTMP
Fin:
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
' Hier wird in den Tabelleblättern Tabelle1, Tabelle2 und Tabelle3 (CodeName der Tabellenblätter) in der Datei mit dem Makro ALLES gelöscht
' und dann neu geschrieben. ABER diesmal in "DieseArbeitsmappe"!!!! Dann gilt es für alle Tabellenblätter - AUCH wenn neue eingefügt werden.
' In "DieseArbeitsmappe" gibt es Events, die für die gesamte Arbeitsmappe gültig sind.
' Dann MÜSSEN aber die Events aus den Tabellenblättern entfernt werden!!!!
Public Sub Main_F()
    Dim lngLine As Long
    Dim lngTMP As Long
    On Error GoTo Fin
    For lngTMP = 1 To 3
        With ThisWorkbook.VBProject.VBComponents("Tabelle" & lngTMP).CodeModule
            .DeleteLines 1, .CountOfLines
            .InsertLines 1, "Option Explicit"
        End With
        With ThisWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule
            .DeleteLines 1, .CountOfLines
            .InsertLines 1, "Option Explicit"
            lngLine = .CreateEventProc("SheetChange", "Workbook")
            .InsertLines lngLine + 1, "    MsgBox (""Klappt doch..."")"
            lngLine = .CreateEventProc("SheetSelectionChange", "Workbook")
            .InsertLines lngLine + 1, "    Beep"
            lngLine = .CreateEventProc("SheetBeforeDoubleClick", "Workbook")
            .InsertLines lngLine + 1, "    MsgBox(""Einer geht noch..."")"
            lngLine = .CreateEventProc("Open", "Workbook")
            .InsertLines lngLine + 1, "    Application.CommandBars.FindControl(ID:=1695).Execute"
        End With
    Next lngTMP
Fin:
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
'Private Const vbext_ct_StdModule = 1
'Private Const vbext_ct_MSForm = 3
'Private Const vbext_ct_Document = 100
'Private Const vbext_ct_ClassModule = 2
'Private Const vbext_ct_ActiveXDesigner = 11
' Oben siehst du die Konstanten und ihre Zahlenwerte. Wieder alles aus dem Objektkatalog geholt.
' In der Bibliothek "VBIDE" ist die Klasse "vbext_ComponentType" mit dem Element "vbext_ct_StdModule".
' F2 im VBA-Editor - vorher Verweis auf "Microsoft Visual Basic for Applications Extensibility 5.3" setzen.
' Im Suchfenster nach "vbext_ct_StdModule" suchen.
' Extras - Verweise - der Haken kann wieder entfernt werden.
' Mit 3 bzw. vbext_ct_MSForm wird z. B. eine UserForm angesprochen.
' Hier legen wir jetzt ein neues Modul an und benennen es. Dann wird eine Sub geschrieben.
' Vorher wird das Modul - wenn es vorhanden ist - gelöscht.
Public Sub Main_G()
    Dim objModul As Object
    On Error GoTo Fin
    With ThisWorkbook.VBProject
        For Each objModul In .VBComponents
            If objModul.Type = 1 And objModul.Name = "MeinModul" Then
                .VBComponents.Remove .VBComponents("MeinModul"): Exit For
            End If
        Next objModul
    End With
    With ThisWorkbook.VBProject.VBComponents
        Set objModul = .Add(1)
        objModul.Name = "MeinModul"
        With objModul.CodeModule
            .InsertLines 1, "Public Sub WolleMerSeRoilosse()"
            .InsertLines 2, "    ' Mit Code - auch diese Kommentarzeile - hinzugefügt!"
            .InsertLines 3, "    MsgBox ""NaChallaMasch"" "
            .InsertLines 4, "End Sub"
        End With
    End With
Fin:
    Set objModul = Nothing
    If Err.Number = 9 Then MsgBox "Tabelle nicht vorhanden!" Else If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub
' Mit einer Schleife Code aus den Tabellenblättern oder DieseArbeitsmappe löschen haben wir ja oben schon gesehen.
' In der Sub "Main_G()" sehen wir wie wir mit einer Schleife durch alle "VBA Komponenten" gehen können.
' Also kann ich mit 1, 2 und 3 alle Klassenmodule, UserFormen und Module löschen.
' Ist der Typ 100, ist der Code in einem Tabellenblatt - hier dann wieder mit ".DeleteLines 1, .CountOfLines" löschen.
' Es ist aber häufig sinnvoller gezielt zu löschen - nicht pauschal alles.

' Hier exportieren wir unsere Codes - erstellen eine neue Arbeitsmappe und importieren die erstellten Dateien dort.
' Je nach Typ benötigen wir unterschiedliche Endungen für die Exportdateien.
' ".bas" ist die Endung für Module, ".cls" für Klassenmodule und Code aus Tabellenblättern und ".frm" für UserFormen.
' Den Klimmzug mit "If...Else...End If" im Code müssen wir machen, da in bestehende Klassenmodule wie "DieseArbeitsmappe"
' nicht direkt importiert werden kann!!!!!! Diese würden als "normale" Klassenmodule angelegt und z. B.
' "DieseArbeitsmappe1" oder "Tabelle11" heissen. Testet es selber indem ihr die drei Codezeilen
' If objModul.Type = 1 Or objModul.Type = 3 Then, Else und End If auskommentiert!!!!!
' (M)man(n) könnte es auch über ".CodeModule.AddFromString" lösen. Viele Wege - Rom - usw.
' Eine weitere Möglichkeit ist einfach zu importieren und dann den Code aus den angelegten Klassen an die richtige
' Stelle zu kopieren.
Public Sub Main_H()
    Dim wkbBook As Workbook
    Dim objModul As Object
    Dim strFile As String
    Dim strTMP As String
    On Error GoTo Fin
    Set wkbBook = Workbooks.Add
    wkbBook.Worksheets.Add Count:=2
    With ThisWorkbook.VBProject
        For Each objModul In .VBComponents
            Select Case objModul.Type
                Case 1: strTMP = ".bas"
                Case 2: strTMP = ".cls"
                Case 100: strTMP = ".clsT"
                Case 3: strTMP = ".frm"
            End Select
            strFile = ThisWorkbook.Path & Application.PathSeparator & objModul.Name & strTMP
            If Not Dir(strFile, vbDirectory) = vbNullString Then Kill strFile
            .VBComponents(objModul.Name).Export strFile
            If objModul.Type = 1 Or objModul.Type = 3 Or strTMP = ".cls" Then
                wkbBook.VBProject.VBComponents.Import strFile
            Else
                wkbBook.VBProject.VBComponents(objModul.Name).CodeModule.AddFromFile strFile
                wkbBook.VBProject.VBComponents(objModul.Name).CodeModule.DeleteLines 1, 6
            End If
        Next objModul
    End With
Fin:
    Set wkbBook = Nothing
    If Err.Number <> 0 Then MsgBox "Err: " & Err.Number & " - " & Err.Description
End Sub

Am einfachsten ladet ihr euch die ZIP-Datei runter. Da ist alles drin.

Was passiert?

• Code in "DieseArbeitsmappe" wird erstellt.
  
• Code in "DieseArbeitsmappe" wird geschrieben.
  
• Code im Tabellenblatt wird erstellt.
  
• Code im Tabellenblatt wird geschrieben.
  
• Ein Modul wird erstellt und eine Sub reingeschrieben.
  
• Das Modul wird gelöscht.
  
• Makros werden exportiert und importiert.
  

Im Code ist einiges an Kommentaren. Auch sind Bilder in der Excel Datei z. B. vom Projektkatalog bzw. Objektkatalog oder auch Objektexplorer.