Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mit Makro anderes Makro ändern ?

Mit Makro anderes Makro ändern ?
Jürgen
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

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

Betreff
Benutzer
Anzeige
AW: Mit Makro anderes Makro ändern ?
14.09.2010 08:27:30
fcs
Hallo Jürgen,
bevor so eine Makro-Modulation möglich ist müssen verschiedene Voraussetzungen erfüllt sein.
1.) Jeder Anwender, der das Makro einsetzen soll/will, muss ggf. eine Makro-Sicherheitseinstellung ändern. Der Zugriff auf das VBA-Modul muss erlaubt werden. Sinnvoller Weise sollte nach der Durchführung des Makros die Einstellung "Zugriff auf VBA-Projekt erlauben" wieder deaktiviert werden.
2.) Das VBA-Projekt darf nicht geschütz sein.
3.) Bei Netztwerkbetrieb muss bei den Anwendern die Anwendung von Makros freigeschaltet sein. Administratoren geben normalerweise die VBA-Code-Manipulation nicht frei.
4.) Virenscanner betrachten Exceldateien mit solchem Code ggf. als feindlich.
In wie vielen Dateien willst du denn auf diese Weise den VBA-Code manipulieren? Bis 50 Dateien würde ich es per Hand machen. Dann ist man halt ggf. 1 bis 2 Stunden beschäftigt, um Fehler der Vergangenheit zu beseitigen.
Die Erstellung einer maßgeschneiderten Prozedur lohnt nur wenn die obigen Voraussetzungen erfüllt sind und viele Dateien zu ändern sind.
Als VBA-Anfänger wäre ich sehr vorsichtig solche Vorgänge zu automatisieren.
Gruß
Franz
Anzeige
AW: Mit Makro anderes Makro ändern ?
14.09.2010 12:54:28
Jürgen
Hallo Franz,
das sind schon so ca. 60 Dateien.
In der Sub :
Private Function GetFirstDate(nMo, nYr, nDOW)
Dim StartRow As Integer
If nYr = 1999 Then
StartRow = 3
ElseIf nYr = 2000 Then
StartRow = 15
ElseIf nYr = 2001 Then
StartRow = 27
ElseIf nYr = 2002 Then
StartRow = 39
ElseIf nYr = 2003 Then
StartRow = 51
ElseIf nYr = 2004 Then
StartRow = 63
ElseIf nYr = 2005 Then
StartRow = 75
ElseIf nYr = 2006 Then
StartRow = 87
ElseIf nYr = 2007 Then
StartRow = 99
ElseIf nYr = 2008 Then
StartRow = 111
ElseIf nYr = 2009 Then
StartRow = 123
ElseIf nYr = 2010 Then
StartRow = 135
End If
GetFirstDate = Sheets("Dates").Cells(StartRow + (nMo - 1), 4 + nDOW)
End Function

sollten nur die Jahreszahlen ersetzt werden.Es sollte dann so aussehen. Ist das leichter zu bewerkstelligen ?
Private Function GetFirstDate(nMo, nYr, nDOW)
Dim StartRow As Integer
If nYr = 2010 Then
StartRow = 3
ElseIf nYr = 2011 Then
StartRow = 15
ElseIf nYr = 2012 Then
StartRow = 27
ElseIf nYr = 2013 Then
StartRow = 39
ElseIf nYr = 2014 Then
StartRow = 51
ElseIf nYr = 2015 Then
StartRow = 63
ElseIf nYr = 2016 Then
StartRow = 75
ElseIf nYr = 2017 Then
StartRow = 87
ElseIf nYr = 2018 Then
StartRow = 99
ElseIf nYr = 2019 Then
StartRow = 111
ElseIf nYr = 2020 Then
StartRow = 123
ElseIf nYr = 2021 Then
StartRow = 135
End If
GetFirstDate = Sheets("Dates").Cells(StartRow + (nMo - 1), 4 + nDOW)
End Function

Gruß Jürgen
Anzeige
AW: Mit Makro anderes Makro ändern
14.09.2010 14:55:33
EvilRik
Hallo Franz,
zu dem Ersetzen kann ich nix sagen.
Trotzdem mal ein anderer Hinweis. Schreib eine Funktion, die Allgemeingültigkeit hat.
Z.B.:
Function GetFirstDate(nMo, nYr, nDOW)
Dim StartRow As Integer, zae1 As Integer, zae2 As Integer, Startdatum As Long
Startdatum = 1999
For zae1 = 1999 To 3000 Step 1
If nYr = zae1 Then
StartRow = 3 + (zae1 - Startdatum) * 12
zae2 = zae2 + 1
If zae2 = 12 Then
Startdatum = zae1 + 1
zae2 = 0
End If
Exit For
End If
Next zae1
GetFirstDate = Sheets("Dates").Cells(StartRow + (nMo - 1), 4 + nDOW)
End Function

Deine Funktion liefert zudem für 2010 unterschiedliche Werte für StartRow (135 bzw. 3).
Vielleicht hilft dir dieser Ansatz weiter. Zumindest für die Zukunft :)
Gruß Henrik
Anzeige
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

Anzeige
AW: Mit Makro anderes Makro ändern ?
15.09.2010 17:27:56
Jürgen
Hallo Franz,
vielen herzlichen Danke. Das einbauen hat super geklappt. Werde zwar noch eine Weile brauchen, bis ich deinen Code verstehe, aber es hat perfekt geklappt.
Wie lange hast Du gebraucht diesen Code zu schreiben wenn ich fragen darf ?
Gruß Jürgen
AW: Mit Makro anderes Makro ändern ?
16.09.2010 08:29:34
fcs
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige