In all files of a folder (without subfolder) import a changed UserForm.
Hier noch eine Beispieldatei / Here's a sample file:
Alle Dateien eines Ordners - UserForm austauschen...[ZIP 250 KB]
Option Explicit '-------------------------------------------------------------------------- ' Module : Modul1 ' Procedure : Main ' Author : Case (Ralf Stolzenburg) ' Date : 20.02.2017 ' Purpose : Alle Dateien eines Ordners - UsrForm austauschen... '-------------------------------------------------------------------------- Sub Main() ' Name der Ex- bzw. Importdatei Const strTMP As String = "uf.frm" Dim strFileName As String Dim strPath As String ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke On Error GoTo Fin ' Bildschirmaktualisierung ausschalten Application.ScreenUpdating = False ' Pfad anpassen!!! Im Moment der Pfad mit der Datei mit diesem Makro strPath = ThisWorkbook.Path ' Letzten Backslash vergessen If Right(strPath, 1) <> "\" Then strPath = strPath & "\" ' Datei schon/noch da, dann löschen If Dir$(Environ$("TEMP") & "\" & strTMP) <> "" Then Kill Environ$("TEMP") & "\" & strTMP End If ' UserForm aus DIESER Datei EXportieren - in TEMP-Ordner Workbooks(ThisWorkbook.Name).VBProject.VBComponents("UserForm1").Export Environ$("TEMP") & "\" & strTMP ' Erste Datei im Ordner suchen strFileName = Dir$(strPath & "*.xls*") ' Schleife über alle Dateien - OHNE Unterordner Do While strFileName <> "" ' DIESE Datei wird nicht berücksichtigt If Not strFileName = ThisWorkbook.Name Then ' Datei öffnen Workbooks.Open strPath & strFileName ' Der Code bezieht sich auf ein bestimmtes Objekt ' Hier die eben geöffnete Datei ' Alles was sich auf dieses "With" bezieht ' MUSS mit einem Punkt beginnen With Workbooks(strFileName) ' Alte UserForm löschen .VBProject.VBComponents.Remove .VBProject.VBComponents("UserForm1") ' Neue Userform IMportieren .VBProject.VBComponents.Import Environ$("TEMP") & "\" & strTMP ' Datei schliessen UND speichern .Close True End With End If ' Nächste Datei strFileName = Dir$() Loop Fin: ' Datei schon/noch da, dann löschen If Dir$(Environ$("TEMP") & "\" & strTMP) <> "" Then Kill Environ$("TEMP") & "\" & strTMP End If ' Bildschirmaktualisierung einschalten Application.ScreenUpdating = True ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung If Err.Number <> 0 Then MsgBox "Error: " & _ Err.Number & " " & Err.Description End Sub