Thema Datum  Von Nutzer Rating
Antwort
Rot VBA filtern, drucken, in Ordner abspeichern oder neu anlegen
22.06.2020 11:17:03 MG_Luca
NotSolved
22.06.2020 11:36:15 Gast40923
NotSolved

Ansicht des Beitrags:
Von:
MG_Luca
Datum:
22.06.2020 11:17:03
Views:
44
Rating: Antwort:
  Ja
Thema:
VBA filtern, drucken, in Ordner abspeichern oder neu anlegen

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





Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA filtern, drucken, in Ordner abspeichern oder neu anlegen
22.06.2020 11:17:03 MG_Luca
NotSolved
22.06.2020 11:36:15 Gast40923
NotSolved