Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
836to840
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
836to840
836to840
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Module in anderes Workbook kopieren

Module in anderes Workbook kopieren
12.01.2007 09:55:37
christian
Hallo zusammen,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Module in anderes Workbook kopieren
12.01.2007 16:25:58
Luschi
Hallo Christian,
ich habe Deinen Code mal getestet. Bei mir läuft der Code beim 1., 2., 3. usw.
Es kommt also keine Fehlermeldung und es wird alles gemacht, was im Code steht.
Einzig der Viren-Wächter (AntiVir von Avira) ging mir mächtig auf den Keks und meldete
Heuristik/Makro-Viren. Ich habe so mir so was Änliches als AddIn erstellt. Da springt AntiVir nicht an.
Kannst Dich ja noch mal melden und genauer sagen, an welcher Stelle der der Fehler auftritt.
Gruß von Luschi
aus klein-Paris
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige