Teil im VBA Code ersetzen und speichern
04.04.2017 11:02:19
Hauke
mittlerweile jabe ich für jeden Kollegen in meiner Abteilung eine Excel Datei angelegt, mit der man Tagesreports erstellen und senden kann. Alles läuft super.
Nun muss ich aber von Zeit zu Zeit Änderungen und Neuerungen einspielen. Dies ist bei 40 Kollegen aber auch etwas Zeit intensiv. Ich habe eine Original-Datei, auf der ich erst alle Änderungen vornehme und dann mittels Suchen, Ersetzen und Speichern unter neuem Namen es für alle Kollegen zugänglich mache. Das lässt sich doch sicher schneller lösen. :D
Folgendes ist nun die Aufgabenstellung:
- VBA Code durchsuchen nach dem Namen des Kollegen zum Beispiel "Max"
- "Max" ersetzen durch "Christian"
- Datei speichern unter "MA-Datei - Christian"
- VBA Code durchsuchen nach dem Namen des Kollegen zum Beispiel "Christian"
- "Christian" ersetzen durch "Paul"
- Datei speichern unter "MA-Datei - Paul"
und immer so weiter.
Ich habe mich bereits daran versucht:
Private Sub CommandButton1_Click()
Call CommandButton2_Click
Call CommandButton3_Click
End Sub
Private Sub CommandButton2_Click()
Dim m As Object, v As Object, VBACode As String
Dim SuchString As String, ErsatzString As String
Dim wb As Workbook
SuchString = "TESTTEST"
ErsatzString = "Max"
For Each v In ActiveWorkbook.VBProject.vbcomponents
If v.Name "UserForm1" Then
Set m = v.CodeModule
If m.CountOfLines > 0 Then
VBACode = m.Lines(1, m.CountOfLines)
VBACode = Replace(VBACode, SuchString, ErsatzString)
m.DeleteLines 1, m.CountOfLines
m.InsertLines 1, VBACode
End If
End If
Next v
ActiveWorkbook.SaveAs Filename:="C:\Users\Desktop\" & ErsatzString & ".xlsm"
Set m = Nothing
Set v = Nothing
End Sub
Private Sub CommandButton3_Click()
Dim m As Object, v As Object, VBACode As String
Dim SuchString As String, ErsatzString As String
Dim wb As Workbook
SuchString = "Max"
ErsatzString = "Hauke"
For Each v In ActiveWorkbook.VBProject.vbcomponents
If v.Name "UserForm1" Then
Set m = v.CodeModule
If m.CountOfLines > 0 Then
VBACode = m.Lines(1, m.CountOfLines)
VBACode = Replace(VBACode, SuchString, ErsatzString)
m.DeleteLines 1, m.CountOfLines
m.InsertLines 1, VBACode
End If
End If
Set m = Nothing
Next v
ActiveWorkbook.SaveAs Filename:="C:\Users\Desktop\" & ErsatzString & ".xlsm"
Set m = Nothing
Set v = Nothing
End Sub
Die erste Datei wird sauber erstellt und dann stürzt Excel ab. Habe schon versucht, das Makro nach dem Durchlauf zu löschen mittels neuem Makro, aber das Problem bleibt bestehen.
Hat vllt jemand eine Idee?
Viele Grüße,
Hauke-Christian
Anzeige