AW: Problem in Userform Programmablauf
23.03.2016 12:52:56
Peter
Hallo Selli,
alles was nach dem x folgt, greift nicht auf die Userform zu sondern findet nur innerhalb der Tabellen und der dazugehörigen Ordner und Unterordner statt.
Ich habe die Makros zusammengestellt und füge diese hier ein:
Sub Kopierkostenabrechnung_umbenennen()
Dim strPfad As String
Dim strTeilPfad As String
Dim strOldName As String, strNewName As String
Dim strOldPfadName As String, strNewPfadName As String
Call Makros_für_WorkbookOpen 'aktualisiert die Hilfstabelle
If Range("V2") = "" Then
Exit Sub
Else
strPfad = Range("A2").Value
strTeilPfad = Range("A6").Value
strOldName = Range("V2").Value
strNewName = Range("Q5") & "_" & Range("S10") & Range("Q6")
strOldPfadName = (strPfad & "\" & strTeilPfad & "\" & strOldName)
strNewPfadName = (strPfad & "\" & strTeilPfad & "\" & strNewName)
End If
'Debug.Print strOldPfadName, strNewPfadName
Dim FS As Object, ordner As Object
Set FS = CreateObject("Scripting.filesystemobject")
Set ordner = FS.GetFolder(strPfad & "\" & strTeilPfad)
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
'Debug.Print strOldPfadName; "As"; strNewPfadName
Name strOldPfadName As strNewPfadName
MsgBox "Die Datei wurde umbenannt"
End If
'' Debug.Print strOldPfadName & " " & strNewPfadName
' Name strOldPfadName As strNewPfadName
End Sub
'diese Makro verschiebt mit Prüfung ob Ordner leer ist alle Dateien ins jeweilige Archiv
Sub Dateien_verschieben_mitPrüfung_Ordner_leer()
Dim strPfad As String
Dim strTeilPfad1 As String
Dim strTeilPfad2 As String
Dim strTeilPfad3 As String
Dim strTeilPfad4 As String
Dim strTeilPfad5 As String
Dim strTeilPfad6 As String
'Dim fs As Object, ordner As Object
Const bolUeberschreiben As Boolean = True
Dim objFSO As Object, ordner As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPfad = Range("A2").Value
strTeilPfad1 = Range("A6").Value
strTeilPfad2 = Range("A7").Value
strTeilPfad3 = Range("A8").Value
strTeilPfad4 = Range("A9").Value
strTeilPfad5 = Range("A10").Value
strTeilPfad6 = Range("A11").Value
Set objFSO = CreateObject("Scripting.filesystemobject")
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\3Kopierkosten _
laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad1)
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.MoveFile strPfad & "\" & strTeilPfad1 & "\" & "*.xlsm", strPfad & "\" & strTeilPfad2
MsgBox "Dateien wurden verschoben"
End If
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\5Serienbrief _
Hauptformular Lehrer Klassen laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad3)
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.MoveFile strPfad & "\" & strTeilPfad3 & "\" & "*.docm", strPfad & "\" & strTeilPfad4
MsgBox "Dateien wurden verschoben"
End If
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\ _
7Kopierkostendrucklisten laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad5)
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.MoveFile strPfad & "\" & strTeilPfad5 & "\" & "*.docm", strPfad & "\" & strTeilPfad6
MsgBox "Dateien wurden verschoben"
End If
Set objFSO = Nothing
End Sub
Sub SaveFile()
Dim strPath As String
Dim strName As String
Dim strTyp As String
Dim aktPfad As String
Dim newPfad As String
aktPfad = Worksheets(1).Range("A2") 'liest den aktuellen Pfad dieser Datei aus
newPfad = Worksheets(1).Range("A6")
strName = Worksheets(1).Range("Q5")
strPath = aktPfad & "\" & newPfad & "\" 'Application.ActiveWorkbook.path 'fehler
strTyp = "." & "xlsm" 'Evtl. Anpassen wenn xlsm Datei! 'vorher xlsx
ChDir strPath
'Debug.Print strPath & strName & strTyp
ActiveWorkbook.SaveAs filename:=strPath & strName & strTyp, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
'dieses Makro löscht mit Prüfung ob Ordner leer sind, alle Dateien aus 00Orginaldateien
Sub Orginaldateien_löschen_mitPrüfung_Ordner_leer()
Dim strPfad As String
Dim strTeilPfad1 As String
Dim strTeilPfad2 As String
Dim strTeilPfad3 As String
Dim strTeilPfad4 As String
' Dim strTeilPfad5 As String
' Dim strTeilPfad6 As String
'Dim fs As Object, ordner As Object
Const bolUeberschreiben As Boolean = True
Dim objFSO As Object, ordner As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPfad = Range("A2") & "\" & Range("A3")
strTeilPfad1 = Range("B3").Value
strTeilPfad2 = Range("B4").Value
strTeilPfad3 = Range("B5").Value
strTeilPfad4 = Range("B6").Value
' strTeilPfad5 = Range("A10").Value
' strTeilPfad6 = Range("A11").Value
Set objFSO = CreateObject("Scripting.filesystemobject")
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\3Kopierkosten _
laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad1)
'Debug.Print ordner
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.DeleteFile strPfad & "\" & strTeilPfad1 & "\" & "*.csv"
MsgBox "Dateien wurden gelöscht"
End If
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\5Serienbrief _
Hauptformular Lehrer Klassen laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad2)
'Debug.Print ordner
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.DeleteFile strPfad & "\" & strTeilPfad2 & "\" & "*.xml"
MsgBox "Dateien wurden gelöscht"
End If
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\ _
7Kopierkostendrucklisten laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad3)
'Debug.Print ordner
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.DeleteFile strPfad & "\" & strTeilPfad3 & "\" & "*.csv"
MsgBox "Dateien wurden gelöscht"
End If
'Set ordner = objFSO.getfolder("C:\Users\Peter\Desktop\Kopierkosten 2016-02-26a\ _
7Kopierkostendrucklisten laufend")
Set ordner = objFSO.GetFolder(strPfad & "\" & strTeilPfad4)
If ordner.SubFolders.Count * 1 + ordner.Files.Count * 1 = 0 Then
MsgBox "Ordner ist leer"
Else
objFSO.DeleteFile strPfad & "\" & strTeilPfad4 & "\" & "*.xml"
MsgBox "Dateien wurden gelöscht"
End If
Set objFSO = Nothing
End Sub
Sub Textzahlen_in_Zahlen_wandeln3()
With Range("H2:H200")
.NumberFormat = "General"
.Value = .Value
End With
End Sub
Ich habe die Makros geprüft und festgestellt, dass das letzte Makro eine bestimmte Tabelle auswählt und dann die Spalte H von Text in Zahlen umwandelt. Dieses Makro wird aber an mehreren Stellen benutzt. Wie kann ich es erreichen, dass nach dem letzten Makro die Userform wieder gestartet wird?
Ggf. müsste das letzte Makro kopiert und umbenannt werden und dort Userform...show eingestellt werden. Sehe ich das so richtig?
Besten Dank
Gruss Peter