Macro voor tabbladen als PDF opslaan met celwaarde als naam

[RudolfVos]

Goedemiddag,

Ik heb een excelbestand met 205 tabbladen.
Wat ik nu graag zou willen is het volgende;

ik zou een macro knop willen maken op een tabblad, wanneer ik deze activeer moeten alle geselecteerde tabbladen apart als PDF worden opgeslagen.
De naam van de PDF per tabblad, is de waarde in cel I8
De bestandsnaam moet dezelfde map zijn als waar het bestand nu is opgeslagen.

Het tabblad waar de knop komt kan worden mee geselecteerd, maar nog mooier zou zijn als die knop gewoon op elk tabblad zou staan.

Wie kan me helpen?

Grt Rudolf

 

[edmoor]

Zo:

Sub Sheets2PDF()
    For Each sh In ActiveWindow.SelectedSheets
        sh.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & sh.Range("I8")
    Next sh
End Sub

 

[RudolfVos]

Hallo Edmoor,

Dit is al helemaal super!
maar nog 1 "probleempje"

Wanneer ik 4 tabbladen geselecteerd heb, dan maakt hij keurig 4 bestandjes aan, met het goede nummer in de goede map.

Echter, nu krijg ik 4 bestanden met ELK 4 samengevoegde tabbladen in het PDF bestand. Het PDF is dus zogezegd "3 bestanden teveel"
Dat is niet de bedoeling, 1 tabblad per PDF is eigenlijk de bedoeling.

Alvast weer bedankt!

 

[edmoor]

Probeer het dan eens zo:

Sub Sheets2PDF()
    For Each sh In ActiveWindow.SelectedSheets
        Sheets(sh.Name).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & sh.Range("I8")
    Next sh
End Sub

 

[RudolfVos]

Hmm...

zelfde probleem.

Weer 3 tabbladen geselecteerd, weer keurig opgeslagen, maar alleen weer 3 tabbladen per PDF bestand

 

[edmoor]

Waarschijnlijk pakt de ExportAsFixedFormat sowieso de geselecteerde bladen.
Doe het dan eens zo:

Sub Sheets2PDF()
    Dim shts() As String
    
    cs = ActiveSheet.Name
    For Each sh In ActiveWindow.SelectedSheets
        ReDim Preserve shts(i)
        shts(i) = sh.Name
        i = i + 1
    Next sh
    
    Sheets(cs).Select
    For i = 0 To UBound(shts)
        Sheets(shts(i)).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Sheets(shts(i)).Range("I8")
    Next i
End Sub

 

[RudolfVos]

Works like a charm!
Ben elke keer weer onder de indruk van de oplossingen!

Nogmaals bedankt!

 

[edmoor]

Graag gedaan
En bedankt voor het direct als opgelost markeren van je vraag.
Er zijn maar weinig "nieuwelingen" die dat doen

 

[RudolfVos]

Tuurlijk! regel zijn regels toch! :thumb: