|
Hallo zusammen,
ich sitze gerade an einem Makro und habe selber leider kaum Erfahrung. Mein Makro ist größtenteils aus Versuchen und anderen Forenbeiträgen entstanden. Nun habe ich jedoch folgendes Problem: Das Makro kann auf eine Spalte in Excel filtern, benennt das Dokument nach dieser Spalte und speichert es ab. Ich möchte aber gerne, dass es auch schaut ob der Ordner (Name identisch wie in Excel) bereits vorhanden ist und wenn nicht ihn neu erstellt.
Es wäre super, wenn mir jemand helfen könnte.
Liebe Grüße Sarah
Hier mal das Beispiel meines AnfängerCodes, der leider nicht funktioniert:
Sub GefiltertDruckenUndSpeichern() 'Um Befehl auszuführen, muss eine Zelle in der Tabelle ausgewählt/angeklickt sein'
Dim noDupes As New Collection
Dim rw As Long
Dim itm As Variant
Dim sFolderPath As String
Dim oFSO As Object
Selection.AutoFilter Field:=14 'Spaltennummer abzählen und dann passend hier und in den folgenden Zeilen einfügen'
rw = ActiveSheet.AutoFilter.Range.Row
For Each cell In ActiveSheet.AutoFilter.Range.Columns(14).Cells
If cell.Row <> rw Then
On Error Resume Next
noDupes.Add cell.Value, cell.Text
On Error GoTo 0
End If
Next
'Um nur Druckbereich zu drucken wurde ActiveSheet.PrintOut verwendet'
For Each itm In noDupes
Selection.AutoFilter Field:=14, Criteria1:=itm
'Pfad definiert des Ordners
sFolderPath = "C:\Test\" & Cells(1, 2) & "\"
'Überprüfe ob der Ordner existiert oder nicht
If Dir(sFolderPath) <> "" Then
'Wenn er existiert
MsgBox "Folder already exists!", vbInformation, "VBAF1"
'Wenn er nicht existiert
MkDir sFolderPath
'Gib die Nachricht aus
MsgBox "New folder has created successfully!", vbInformation, "VBAF1"
End If
'Speicherbefehl hier eingefügt, um nach jedem Filter und Druck die Datei zu speichern'
ChDir "C:\Test\" & Cells(1, 2) & "\" 'Hier den passenden Pfad einfügen'"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Cells(3, 2).Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'durch itm wird der Dateiname um den Namen aus der in itm definierten Zelle erweitert'
'ActiveSheet.PrintPreview 'Printout zum tatsächlichen drucken, PrintPreview für Vorschau'
Next
End Sub
Der Code, welcher nur filtert und speichert sah so aus:
Sub GefiltertDruckenUndSpeichern() 'Um Befehl auszuführen, muss eine Zelle in der Tabelle ausgewählt/angeklickt sein'
Dim noDupes As New Collection
Dim rw As Long
Dim itm As Variant
Selection.AutoFilter Field:=7 'Spaltennummer abzählen und dann passend hier und in den folgenden Zeilen einfügen'
rw = ActiveSheet.AutoFilter.Range.Row
For Each cell In ActiveSheet.AutoFilter.Range.Columns(7).Cells
If cell.Row <> rw Then
On Error Resume Next
noDupes.Add cell.Value, cell.Text
On Error GoTo 0
End If
Next
'Um nur Druckbereich zu drucken wurde ActiveSheet.PrintOut verwendet'
For Each itm In noDupes
Selection.AutoFilter Field:=7, Criteria1:=itm
'Speicherbefehl hier eingefügt, um nach jedem Filter und Druck die Datei zu speichern'
ChDir "C:\Test\" & Cells(1, 2) & "\" 'Hier den passenden Pfad einfügen'"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Cells(3, 2).Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'durch itm wird der Dateiname um den Namen aus der in itm definierten Zelle erweitert'
'ActiveSheet.PrintPreview 'Printout zum tatsächlichen drucken, PrintPreview für Vorschau'
Next
End Sub
|