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

In Spalte A steht fortlaufend das Datum. Dies soll über eine UserForm gefiltert und als PDF gespeichert werden.

In column A continuously is the date. This should be filtered through a UserForm and saved as a PDF.

Hier noch eine Beispieldatei / Here's a sample file:
UserForm - Datum - Filtern - als PDF speichern...[XLSM 60 KB]

' Variablendeklaration erforderlich
Option Explicit
'--------------------------------------------------------------------------
' Module    : UserForm1
' Procedure : UserForm_Activate
' Author    : © Case (Ralf Stolzenburg)
' Date      : 04.01.2016
' Purpose   : Bereich - Datum - Filtern - PDF speichern...
'--------------------------------------------------------------------------
Private Sub UserForm_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
    With ComboBox1
        .ListIndex = 0
        .SetFocus
        .SelStart = 0
        .SelLength = Len(ComboBox1)
    End With
    ' 16ten Eintrag von ComboBox2 anzeigen (Zählung beginnt bei 0)
    ComboBox2.ListIndex = 15
End Sub
Private Sub CommandButton1_Click()
    ' Variablendeklaration
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    ' Wenn ComboBox1 oder 2 leer ist - Meldung ausgeben
    If Me.ComboBox1.Text = "" Or Me.ComboBox2.Text = "" Then
        If Me.ComboBox1.Text = "" Then
            MsgBox "Startdatum angeben!"
            Me.ComboBox1.SetFocus
        Else
            MsgBox "Enddatum angeben!"
            ComboBox2.SetFocus
        End If
    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
        With Tabelle1
            ' Filtern und als PDF auf dem Desktop speichern
            .Range("A1").AutoFilter Field:=1, _
            Criteria1:=">=" & CDbl(DateValue(ComboBox1)), _
            Operator:=xlAnd, Criteria2:="<=" & CDbl(DateValue(ComboBox2))
            .ExportAsFixedFormat 0, 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 .AutoFilterMode And .FilterMode Then .ShowAllData
            ' Autofilter löschen
            .Rows.AutoFilter
            ' Seitenumbruchlinien ausblenden
            .DisplayAutomaticPageBreaks = False
        End With
    End If
Fin:
    ' Die Applikation aufwecken
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = lngCalc
        .DisplayAlerts = True
    End With
    ' Wenn die Fehlernummer NICHT 0 ist, dann gib die Fehlernummer
    ' und die Fehlerbeschreibung aus
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Sub ComboBox2_DropButtonClick()
    ' Eintrag in ComboBox2 komplett markieren
    With ComboBox2
        .SetFocus
        .SelStart = 0
        .SelLength = Len(ComboBox2)
    End With
End Sub
Private Sub CommandButton2_Click()
    ' UserForm entladen
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' Schliessen über das "x" unterbinden
    If CloseMode = 0 Then Cancel = True
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...