Automatisieren: Filtern, PDF speichern usw.

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Automatisieren: Filtern, PDF speichern usw.
von: Marzena
Geschrieben am: 07.08.2015 15:58:43

Hallo Zusammen,
habe eine umfangreiche Exceltabelle. Jede Zeile ist so aufgebaut: KUNDENNAME, ADRESSE, VERTRETER, UMSATZ. Eine Zeile pro Kunde. Aufgabe ist es jedem Vertreter nur seine eigenen Umsätze per E-Mail zukommen zu lassen.
Ich benutze dann den Filter von Excel und filtere mir dann einen einzelnen Vertreter raus (bzw. blende die anderen Vertreter aus) und speichere anschließend als PDF und filtere dann den nächsten Vertreter und speichere wieder als PDF usw. usw.
Gibt es eine Möglichkeit diesen Vorgang zu automatisieren?
Viele Grüße
Marzena

Bild

Betrifft: AW: Automatisieren: Filtern, PDF speichern usw.
von: Sepp
Geschrieben am: 07.08.2015 16:25:30
Hallo Marzena,
Daten beginnen in A1 (Überschriften), die PDF's werden im Verzeichnis der Datei gespeichert, Tabellenname im Code anpassen.

' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub FilterAndSavePDF()
Dim vntFilter As Variant, vntItem As Variant


On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

With Sheets("Tabelle6") 'Tabellenname - Anpassen!
  If .FilterMode Then .ShowAllData
  vntFilter = .Range("C2:C" & Application.Max(2, .Cells(.Rows.Count, 3).End(xlUp).Row))
  vntFilter = toArraySorted(vntFilter)
  For Each vntItem In vntFilter
    .Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=vntItem, Operator:=xlAnd
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & vntItem & ".pdf"
  Next
End With

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'FilterAndSavePDF'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - FilterAndSavePDF"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With

End Sub


Public Function toArraySorted(Field As Variant, Optional Uniqe As Boolean = True) As Variant
Dim objArrayList As Object
Dim lngR As Long, lngC As Long

On Error GoTo ErrExit

Set objArrayList = CreateObject("System.Collections.Arraylist")

With objArrayList
  For lngR = LBound(Field, 1) To UBound(Field, 1)
    For lngC = LBound(Field, 2) To UBound(Field, 2)
      If Not .Contains(Trim(Field(lngR, lngC))) Or Not Uniqe Then
        If Field(lngR, lngC) <> "" Then .Add Trim(Field(lngR, lngC))
      End If
    Next
  Next
  .Sort
  toArraySorted = .toArray
End With

Exit Function
ErrExit:
toArraySorted = -1
End Function


Gruß Sepp


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Automatisieren: Filtern, PDF speichern usw."