AW: Mit Makro anderes Makro ändern ?
15.09.2010 00:26:02
fcs
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