UserForm - Datum - Filtern - als PDF speichern...

' Variablendeklaration erforderlich
OptionExplicit
'--------------------------------------------------------------------------
' Module    : UserForm1
' Procedure : UserForm_Activate
' Author    : © Case (Ralf Stolzenburg)
' Date      : 04.01.2016
' Purpose   : Bereich - Datum - Filtern - PDF speichern...
'--------------------------------------------------------------------------
PrivateSubUserForm_Activate()
' Tabelle1 Spalte A in Combobox schreiben
ComboBox1.List=Tabelle1.Range("A2:A"&Cells(Rows.Count,1).End(xlUp).Row).Value
' Inhalt ComboBox2 = ComboBox1
ComboBox2.List=ComboBox1.List
' Eintrag in ComboBox1 komplett markieren - ersten Eintrag anzeigen
WithComboBox1
.ListIndex=0
.SetFocus
.SelStart=0
.SelLength=Len(ComboBox1)
EndWith
' 16ten Eintrag von ComboBox2 anzeigen (Zählung beginnt bei 0)
ComboBox2.ListIndex=15
EndSub
PrivateSubCommandButton1_Click()
' Variablendeklaration
DimlngCalcAsLong
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
OnErrorGoToFin
' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
WithApplication
.ScreenUpdating=False
.EnableEvents=False
lngCalc=.Calculation
.Calculation=xlCalculationManual
.DisplayAlerts=False
EndWith
' Wenn ComboBox1 oder 2 leer ist - Meldung ausgeben
IfMe.ComboBox1.Text=""OrMe.ComboBox2.Text=""Then
IfMe.ComboBox1.Text=""Then
MsgBox"Startdatum angeben!"
Me.ComboBox1.SetFocus
Else
MsgBox"Enddatum angeben!"
ComboBox2.SetFocus
EndIf
Else
' Der Code bezieht sich auf ein bestimmtes Objekt
' Hier Tabelle1 = der CodeName der Tabelle
' Im VBA-Editor der Name VOR der Klammer - Tabelle1 (Tabelle1)
' im englischen Excel in der Regel Sheet1
' Alles was sich auf dieses "With" bezieht
' MUSS mit einem Punkt beginnen
WithTabelle1
' Filtern und als PDF auf dem Desktop speichern
.Range("A1").AutoFilterField:=1,_
Criteria1:=">="&CDbl(DateValue(ComboBox1)),_
Operator:=xlAnd,Criteria2:="<="&CDbl(DateValue(ComboBox2))
.ExportAsFixedFormat0,Environ("UserProfile")&_
"\Desktop\"&Left(ThisWorkbook.Name,_
(InStrRev(ThisWorkbook.Name,".")-1))&_
Format(Now,"_DD.MM.YYYY"),,,,,,False
' Wenn Autofilter und gefiltert dann alle Daten zeigen
If.AutoFilterModeAnd.FilterModeThen.ShowAllData
' Autofilter löschen
.Rows.AutoFilter
' Seitenumbruchlinien ausblenden
.DisplayAutomaticPageBreaks=False
EndWith
EndIf
Fin:
' Die Applikation aufwecken
WithApplication
.ScreenUpdating=True
.EnableEvents=True
.Calculation=lngCalc
.DisplayAlerts=True
EndWith
' Wenn die Fehlernummer NICHT 0 ist, dann gib die Fehlernummer
' und die Fehlerbeschreibung aus
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
PrivateSubComboBox2_DropButtonClick()
' Eintrag in ComboBox2 komplett markieren
WithComboBox2
.SetFocus
.SelStart=0
.SelLength=Len(ComboBox2)
EndWith
EndSub
PrivateSubCommandButton2_Click()
' UserForm entladen
UnloadMe
EndSub
PrivateSubUserForm_QueryClose(CancelAsInteger,CloseModeAsInteger)
' Schliessen über das "x" unterbinden
IfCloseMode=0ThenCancel=True
EndSub