Listbox Sheet Auswahl Einzeln als PDf Speichern

[toto18]

Hallo Liebes Excel Profis,

ich kann leider wiedermal nicht auf eure Hilfe verzichten.

Ausgangsposition :

Ich habe eine kleine Userform mit einer listbox & Multiselct und einem CB.
In der Listbox werden alle Tabellenblätter geladen bis auf die, die ich vorher ausgegrenzt habe.
Und Ziel Ist es das ich die anwahl in der Listbox die jeweiligen Tabellenbläter mit einem Klick auf die CB, einzeln als Pdf Speichern kann.
Jetzt habe ich an einem Code Gebastelt der so ohne weiteres funktioniert aber ich bekomme es nur so hin das er mir die gesamt auswahl in eine Einzige Zusammenhängende Pdf Generiert..
Und weiß nicht wie ich den den Code schreiben Soll, damit er es einzeln macht.
Deweiteren würde ich gerne die Auwahl mit den Namen des jeweiligen Tabellensheet sowie sie in der Listbox Stehen als Dateinamen haben... aber auch da weiß ich nicht wie...
Vielen Lieben Dank für Eure Zeit und Geduld.
Unten Stehend mein Aktueller Code

Code:

Option Explicit

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim TB_Wahl() As String
    Dim j As Integer
   
    Dim ActiveSheet_Merker As Worksheet
   
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve TB_Wahl(j)
                TB_Wahl(j) = .List(i)
                j = j + 1
            End If
        Next
    End With
   
    If j > 0 Then
        Application.ScreenUpdating = False
        Set ActiveSheet_Merker = ActiveSheet
        Worksheets(TB_Wahl).Select
       
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\xy.pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
           
        ActiveSheet_Merker.Activate
        Set ActiveSheet_Merker = Nothing
        Application.ScreenUpdating = True
    Else
        MsgBox "Bitte mind. 1 Wahl treffen!"
    End If
   
End Sub
Private Sub Userform_Initialize()
    Dim i As Integer
   
    For i = 1 To Worksheets.Count
        If Worksheets(i).Visible = True Then
            Select Case i
                Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
                Case Else
                Me.ListBox1.AddItem Worksheets(i).Name
            End Select
        End If
    Next
End Sub

[RPP63]

Moin!
Mit Deiner Schleife füllst Du ein Array mit den relevanten Blatt-Indizes.
Mit Worksheets(TB_Wahl).Select führst Du eine Gruppierung aus, daher wird im folgenden ein "Gesamt-PDF" erzeugt.

Iteriere durch die .SelectedItems und nehme die .ExportAsFixedFormat-Methode in die Schleife.
Berücksichtige, dass Du den Dateinamen jeweils anpassen musst, sonst überschreibst Du.

Gruß Ralf

[toto18]

Hi RPP63,

kannst du mir helfen wir der Code dann korrekt geschrieben sein müsste ich bin leider nicht so profi...und mehr oder minder am anfang mit allem.

[RPP63]

Lade mal Deine anonymisierte(?) Datei hoch, dann muss ich nicht basteln.

[toto18]

Naja nicht wirklich annonym Formular und PDFSAFE ist die Userform dafür.

[toto18]

Kann Niemand Helfen ?

[Case]

Hallo, :19:

deine Datei zurück: :21:

  Bestellmappe_CCM 2020_1.0.xlsm (Größe: 435,82 KB / Downloads: 5)

[toto18]

Du bist ja sowas von Mega Geil,
Und auch gleich noch den anderen Button mit Code versehen
Es funktioniert super!!! Tausend Dank. :18: :18: :18: :18:

Wenn es nicht zu Unverschämt ist, in einer Zweiten Userform möchte ich das vom Prinzip Wiederholen nur für eine Exceldatei mit Makros.
ALso sprich man wählt aus in der Listbox welche Sheets man haben möchte dann soll per click auf dem Button ein Speicher Unter Funktion auf gehen wo man nur noch den Namen eingibt und sagt wo er speichern soll und automatisch das Dateiformat vorgegeben ist. Und in diesem Fall die Angewählten Sheets als Mappe zusammenstellt.
Geht sowas ?

[Case]

Hallo, :19:

habe es mal in eine UserForm gepackt. Du kannst es ja trennen, wenn du willst. Anpassungen beachten.

  Bestellmappe_CCM 2020_1.0_1.xlsm (Größe: 436,39 KB / Downloads: 3)

[toto18]

Echt toll Case wie du das Kannst.
Du warst mir eine Große Hilfe, Danke sehr. Hab jetzt einige Tage kopfzerbrechen weniger  :18: :18: :18: :18:
Danke Schön