Mit Makro anderes Makro ändern ?

Jürgen · 1970-01-01T00:00:00+00:00

Hallo, ich möchte mittels Makro in einem anderen Makro : Das Modul heißt Create Sched Macros und die Sub heißt : GetFirstDate die Sub sozusagen durch eine geänderte ersetzen, also die ganze Sub markieren (Z402,S1 - Z430,S13)und durch einen zuvor kopierten Text (geänderte Sub !!) ersetzen. Geht das ? Gruß Jürgen

Hallo Jürgen,
hier eine entsprechende Sub und Function zum Ersetzen des Codes einer Prozedur in einem Modul einer Datei.
Der neue Code muss in einer Textdatei gespeichert werden.
Die Arbeitsmappe, und die Namen von Prozedur, Modul und Name der Textdatei werden als Parameter an die Function übergeben. Die Namen muss du ggf. anpassen.
Die Prozeduren speicherst du am besten in einem allgemeinen Modul deiner Persönlichen Makroarbeitsmappe PERSONAL.XLSB oder PERSONL.XLS.
Bitte Funktion des Makros unbedingt an einer Sicherheitskopie einer Dateien probieren!!!!!
Zum Ändern des Codes der Function entsprechende Datei öffnen, dann das Makro starten.
Gruß
Franz

'Prozedur erstellt  unter Excel 2007
'2010-09-14, fcs
Sub Code_Ersetzen_Function_GetFirstDate()
'Name der auszutauschenden Prozedur
If Code_Ersetzen(wbVBA:=ActiveWorkbook, _
ProzedurName:="Private Function GetFirstDate", _
ModuleName:="Create_Sched_Macros", _
CodeNeu_Datei:="C:\Users\Public\Test\Code Function GetFirstDate.txt") = False Then
MsgBox "Code konnte nicht ersetzt werden"
Else
MsgBox "Code erfolgreich ersetzt"
End If
End Sub
Function Code_Ersetzen(wbVBA As Workbook, ProzedurName$, ModuleName$, _
CodeNeu_Datei$) As Boolean
'Prozedur erstellt  unter Excel 2007
'2010-09-14, fcs
'Code einer Prozedur in einem Module der Arbeitsmappe/Workbook _
durch neuen Code aus einer Text-Datei ersetzen
'Zur Ausführung der Prozedur muss:
'1. In Excel unter Extras --> Optionen --> Sicherheit --> Makrosicherheit _
die Option "Zugriff auf das VB-Projekt vertrauen" aktiviert werden.
Dim Zeile As Long, Zeile1 As Long, Zeile2 As Long, Spalte As Long
Dim sCodeNeu As String, sSuch As String
On Error GoTo Fehler
If InStr(1, ProzedurName, "Function ") > 0 Then
sSuch = "End Function"
ElseIf InStr(1, ProzedurName, "Sub ") > 0 Then
sSuch = "End Sub"
Else
MsgBox "Prozedurname muss ""Sub "" oder ""Function "" enthalten!" & vbLf & vbLf _
& "Prozedur-Name: " & ProzedurName & vbLf & vbLf & "Makro wird abgebrochen!", _
vbInformation + vbOKOnly, "Code Prozedur ersetzen"
Code_Ersetzen = False
GoTo Fehler
End If
If Dir(CodeNeu_Datei) = "" Then
Err.Raise 53
GoTo Fehler
End If
If MsgBox("Prozedur """ & ProzedurName & """" & vbLf & "in Modul """ & ModuleName _
& """" & vbLf & "des VBA-Projekts der Datei """ _
& wbVBA.Name & """ austauschen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Code Prozedur ersetzen") = vbYes Then
With wbVBA.VBProject.VBComponents(ModuleName).CodeModule
'Name/1. Zeile der Prozedur im Modul suchen
Zeile1 = 1
Spalte = 1
If .Find(ProzedurName, Zeile1, Spalte, .CountOfLines, -1) = True Then
'Letzte Zeile der Function/Sub suchen
Zeile2 = Zeile1 + 1
Do Until InStr(1, .Lines(Zeile2, 1), sSuch)
Zeile2 = Zeile2 + 1
Loop
'Function/Sub löschen
.DeleteLines Zeile1, Zeile2 - Zeile1 + 1
'Neuen Code der Function/Sub zeilenweise aus Textdatei einfügen
Open CodeNeu_Datei For Input As #1
Zeile = Zeile1
Do Until EOF(1)
Line Input #1, sCodeNeu
.InsertLines Zeile, sCodeNeu
Zeile = Zeile + 1
Loop
Close #1
Else
MsgBox "Prozedur """ & ProzedurName & """ in Modul """ _
& ModuleName & """ der Datei """ & wbVBA & """ nicht vorhanden!"
End If
End With
End If
Code_Ersetzen = True
Fehler:
With Err
If .Number  0 Then
Code_Ersetzen = False
Select Case .Number
Case 9
MsgBox "Fehler: " & .Number & vbLf & .Description & vbLf _
& "Modul mit Name """ & ModuleName & """ in VBA-Projekt nicht vorhanden!"
Case 53
MsgBox "Fehler: " & .Number & vbLf & .Description & vbLf _
& "Bitte Name der Textdatei mit neuem Code prüfen." & vbLf _
& "Datei-Name: " & CodeNeu_Datei
Case 1004
If Val(Left(Application.Version, 2))  ""Optionen""" & vbLf _
& " --> ""Sicherheit" & vbLf _
& " --> ""Makrosicherheit""" & vbLf _
& " die Option ""Zugriff auf das VBA-Projekt vertrauen"" aktivieren!", _
vbInformation + vbOKOnly, _
"Code einer Prozedur ersetzen - Excel 2003 und älter"
Else
MsgBox "Fehler: " & .Number & vbLf & .Description & vbLf _
& "Vor Start des Makros unter Excel-Optionen " & vbLf _
& "--> ""Vertrauensstellungscenter""" & vbLf _
& "--> ""Einstellungen für das Vertrauensstellungscenter ...""" & vbLf _
& "--> ""Einstellungen für Makros""" & vbLf & "die Option " _
& """Zugriff auf das VBA-Projektobjektmodell vertrauen"" aktivieren!", _
vbInformation + vbOKOnly, _
"Code einer Prozedur ersetzen - Excel 2007 und neuer"
End If
Case Else
MsgBox "Fehler: " & .Number & vbLf & .Description
End Select
Close
End If
End With
End Function

Hallo Jürgen,
ein Grundgerüst zum Zugriff auf die Module eines VBA-Projekts (hier die Ausgabe aller Module via Export aus dem VBA-Edititor) hatte ich schon.
Da hab ich dann deine Wünsche eingebaut.
Die meiste Zeit ging dann drauf, mögliche Fehler auzutesten und entsprechende Prüfungen einzubauen.
Insgesamt dann ca. 1 Stunde.
Gruß
Franz
Vor dem intensiven Testen sah die Function etwa so aus.

Function Code_Ersetzen(wbVBA As Workbook, ProzedurName$, ModuleName$, _
CodeNeu_Datei$) As Boolean
'Prozedur erstellt  unter Excel 2007
'2010-09-14, fcs
'Code einer Prozedur in einem Module der Arbeitsmappe/Workbook _
durch neuen Code aus einer Text-Datei ersetzen
'Zur Ausführung der Prozedur muss:
'1. In Excel unter Extras --> Optionen --> Sicherheit --> Makrosicherheit _
die Option "Zugriff auf das VB-Projekt vertrauen" aktiviert werden.
Dim Zeile As Long, Zeile1 As Long, Zeile2 As Long, Spalte As Long
Dim sCodeNeu As String, sSuch As String
On Error GoTo Fehler
If InStr(1, ProzedurName, "Function ") > 0 Then
sSuch = "End Function"
ElseIf InStr(1, ProzedurName, "Sub ") > 0 Then
sSuch = "End Sub"
Else
GoTo Fehler
End If
If MsgBox("Prozedur """ & ProzedurName & """" & vbLf & "in Modul """ & ModuleName _
& """" & vbLf & "des VBA-Projekts der Datei """ _
& wbVBA.Name & """ austauschen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Code Prozedur ersetzen") = vbYes Then
With wbVBA.VBProject.VBComponents(ModuleName).CodeModule
'Name/1. Zeile der Prozedur im Modul suchen
Zeile1 = 1
Spalte = 1
If .Find(ProzedurName, Zeile1, Spalte, .CountOfLines, -1) = True Then
'Letzte Zeile der Function/Sub suchen
Zeile2 = Zeile1 + 1
Do Until InStr(1, .Lines(Zeile2, 1), sSuch)
Zeile2 = Zeile2 + 1
Loop
'Function/Sub löschen
.DeleteLines Zeile1, Zeile2 - Zeile1 + 1
'Neuen Code der Function/Sub zeilenweise aus Textdatei einfügen
Open CodeNeu_Datei For Input As #1
Zeile = Zeile1
Do Until EOF(1)
Line Input #1, sCodeNeu
.InsertLines Zeile, sCodeNeu
Zeile = Zeile + 1
Loop
Close #1
Else
MsgBox "Prozedur """ & ProzedurName & """ in Modul """ _
& ModuleName & """ der Datei """ & wbVBA & """ nicht vorhanden!"
End If
End With
End If
Code_Ersetzen = True
Fehler:
With Err
If .Number  0 Then
Code_Ersetzen = False
MsgBox "Fehler: " & .Number & vbLf & .Description
Close
End If
End With
End Function

Mit Makro anderes Makro ändern ?

Forumthread: Mit Makro anderes Makro ändern ?

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial

Excel Makro ändern: So bearbeitest Du Makros mit VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Mit Makro anderes Makro ändern ?

Forumthread: Mit Makro anderes Makro ändern ?

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Excel Makro ändern: So bearbeitest Du Makros mit VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread