um Programmstände zu aktualisieren kopiere ich alle Module, UserFormen und ausgewählte Sheets von einem Wokbook in ein zweites.
Der Code funktioniert aber nur 1x. Beim 2. Mal bricht Excel mit Fehlermeldung ab. Dannach geht es wieder ...
Wer kann helfen, hier der Code der betreffenden SUB:
Sub COPYMODULE()
Dim MPath As String
MPath = Application.Path & "\"
Dim strCode As String
'Module + UserFormen zählen
For Each objVBModul In ThisWorkbook.VBProject.VBComponents
Select Case objVBModul.Type
Case 1
ZModule = ZModule + 1
Case 3
ZUserform = ZUserform + 1
End Select
Next
'Updatedatei öffnen
FileToOpen = Application.GetOpenFilename("Microsoft Excel-Dateien (*.xls), *.xls")
Workbooks.Open FileToOpen
MsgBox "Anzahl Module : " & ZModule & Chr(10) & _
"Anzahl Userform: " & ZUserform & Chr(10) & _
Chr(10) & "RUP-Generator-Update wird gestartet!"
'Code in "DieseArbeitsmappe" löschen
With ActiveWorkbook.VBProject
For Each objVBModul In .VBComponents
Select Case objVBModul.Type
Case 100
With objVBModul.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next objVBModul
End With
'Schließen und wieder Öffnen um Module die "DieseArbeitsmappe" angesprochen wurden
'löschen zu können
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks.Open FileToOpen
Application.DisplayAlerts = True
'UserFormen + Module löschen
With ActiveWorkbook.VBProject
For Each objVBModul In .VBComponents
Select Case objVBModul.Type
Case 1, 3 '1=Module, 3=UserForm
.VBComponents.Remove objVBModul
End Select
Next objVBModul
End With
'Module und UserFormen schreiben
For MUF = 1 To ZUserform
With ThisWorkbook.VBProject
.VBComponents("UserForm" & MUF).Export MPath & "basMain.frm"
End With
With ActiveWorkbook.VBProject
.VBComponents.Import MPath & "basMain.frm"
Kill MPath & "\basMain.frm"
End With
Next
For MUF = 1 To ZModule
With ThisWorkbook.VBProject
.VBComponents("Modul" & MUF).Export MPath & "basMain.bas"
End With
With ActiveWorkbook.VBProject
.VBComponents.Import MPath & "basMain.bas"
Kill MPath & "\basMain.bas"
End With
Next
'Code unter DieseArbeitsmappe in andere Datei übertragen
strCode = ThisWorkbook.VBProject.VBComponents("DieseArbeitsmappe"). _
CodeModule.Lines(1, 50)
ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe"). _
CodeModule.AddFromString strCode
'RUP-Generator-Version in Kommentar schreiben
ActiveWorkbook.BuiltinDocumentProperties(3) = ThisWorkbook.BuiltinDocumentProperties(3)
'IEC-Code Worksheeet aktualisieren
ThisWorkbook.Worksheets("IEC_Code").Range("A1:A200").Copy
ActiveSheet.Paste Destination:=Worksheets("IEC_Code").Range("A1:A200")
'Worksheet WS_PR_Vorlage entweder aktualisieren oder erstellen
For n = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(n).Name = "WS_PR_Vorlage" Then
ActiveWorkbook.Sheets("WS_PR_Vorlage").Delete
GoTo WEITER
End If
Next n
WEITER:
ThisWorkbook.Worksheets("WS_PR_Vorlage").Copy After:=ActiveWorkbook.Worksheets("Archiv")
'Worksheet WS_PR_Vorlage entweder aktualisieren oder erstellen
For n = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(n).Name = "WS_BG_Vorlage" Then
ActiveWorkbook.Sheets("WS_BG_Vorlage").Delete
GoTo WEITER1
End If
Next n
WEITER1:
ThisWorkbook.Worksheets("WS_BG_Vorlage").Copy After:=ActiveWorkbook.Worksheets("Archiv")
'Worksheet WS_PR_Vorlage entweder aktualisieren oder erstellen
For n = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(n).Name = "WS_BF_Vorlage" Then
ActiveWorkbook.Sheets("WS_BF_Vorlage").Delete
GoTo WEITER2
End If
Next n
WEITER2:
ThisWorkbook.Worksheets("WS_BF_Vorlage").Copy After:=ActiveWorkbook.Worksheets("Archiv")
'Schreibschutz auf WS("Programmübersicht") setzen
'ActiveWorkbook.Worksheets("Programmübersicht").Protect
MsgBox "RUP-Generator wurde aktualisiert!"
ActiveWorkbook.Save
ActiveWorkbook.Close
ThisWorkbook.Close
End Sub
Bin mal gespannt...
Danke, Christian