Mit VBA eine Userform im VBA-Projekt austausch
07.05.2014 12:57:11
fcs
Hallo Helmut,
das ist nicht ganz ohne.
1. Voraussetzung
Du musst unter Optionen--Sicherheitscenter--Einstellungen--Einstellungen für Makros die Option "Zugriff auf das VBA-Prjektobjektmdell vertrauen" aktivieren.
Diese Einstellung solltest du aus Sicherheitsgründen nach Abschluß des Austausches wieder zurücksetzen.
2. Voraussetzung
Das VBA-Projekt in den Dateien darf nicht per Kennwort geschützt sein.
Mit folgendem Makro kann man dann im Prinzip so einen Versions-Update eines Userforms durchführen.
Den Namen des Userforms und die Quelle der Liste der Dateinamen muss du noch anpassen.
Gruß
Franz
Sub Userform_Modul_austauschen()
Dim vbaComp As Object
Dim strFilecomp As String, strUF_Name As String
Dim varFile, varFiles
Dim wkb As Workbook, wkbZiel As Workbook
Dim intFehler, strMsgTitel As String
Dim StatusCalc As Long
On Error GoTo Fehler
intFehler = 1
'Userform aus aktiver Mappe exportieren
strUF_Name = "UF_xyz" 'Name anpassen!!!!
Set wkb = ActiveWorkbook
Set vbaComp = wkb.VBProject.VBComponents(strUF_Name)
strFilecomp = wkb.Path & "\" & vbaComp.Name
vbaComp.Export Filename:=strFilecomp & ".frm"
'Zellbereich mit Pafd\Dateiname der zu aktualisierenden Dateien
varFiles = wkb.Worksheets("Tabelle1").Range("A11:A12")
intFehler = 2
'Makrobremsen lösen
Application.EnableEvents = False 'zwingend erforderlich um ggf. Start von Ereignismakros _
zu verhindern
Application.ScreenUpdating = False
StatusCalc = Application.Calculation
Application.Calculation = xlCalculationManual
'Dateiliste abarbeiten
For Each varFile In varFiles
Set wkbZiel = Workbooks.Open(Filename:=varFile, UpdateLinks:=False)
Set vbaComp = wkbZiel.VBProject.VBComponents(strUF_Name)
wkbZiel.VBProject.VBComponents.Remove vbaComp
wkbZiel.VBProject.VBComponents.Import Filename:=strFilecomp & ".frm"
ResumeCloseZiel:
wkbZiel.Close savechanges:=True
ResumeNextDatei:
Next
intFehler = 3
'Exportierte Code-Dateien .frm und .frx wieder löschen
Kill strFilecomp & ".*"
MsgBox "Fertig"
Fehler:
strMsgTitel = "Makro: Userform_Modul_austauschen"
With Err
Select Case .Number
Case 0
Case 9
If intFehler = 1 Then
MsgBox "Userform """ & strUF_Name & vbLf & """ in " & wkb.Name _
& vbLf & "nicht vorhanden", _
vbInformation + vbOKOnly, strMsgTitel
ElseIf intFehler = 2 Then
MsgBox "Userform """ & strUF_Name & vbLf & """ in Datei " & varFile _
& vbLf & "nicht vorhanden", _
vbInformation + vbOKOnly, strMsgTitel
Resume ResumeCloseZiel
End If
Case 1004
MsgBox "Datei " & varFile & vbLf & "wurde nicht gefunden", _
vbInformation + vbOKOnly, strMsgTitel
Resume ResumeNextDatei
Case Else
MsgBox "Fehler-Nr: " & .Number & vbLf & .Description, _
vbOKOnly, strMsgTitel
End Select
End With
'Makrobremsen zurücksetzen
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = StatusCalc
Set wkb = Nothing: Set wkbZiel = Nothing: Set vbaComp = Nothing
End Sub