Genereren PDF dmv Excel VBA

[Pas Cal]

Goedenavond, ik gebruik een VBA script om PDF te generen. Afhankelijk van het soort rapport moet er bepaalde tabbladen wel/niet als PDF gegenereerd worden. Ik doe dat als volgt:

Sub PrintSelectionToPDF()

fonds = Sheets("Opstarten").Range("B1").Value
naam = fonds 
info1 = Sheets("Opstarten").Range("B14").Value

If info1 = "Ja" Then
ThisWorkbook.Sheets(Array("Voorblad", "Rapportage", "Info", "Achterblad")).Select
End If

If info1 = "Nee" Then
ThisWorkbook.Sheets(Array("Voorblad", "Rapportage", "Achterblad")).Select
End If

   ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:="C:\Users\**********\Rapportage_" & naam, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True


End Sub

 

Nu moet er nog een combinatie bijkomen.  Is er een manier om de inhoud in de Array dynamisch te maken bv? BV:

afdrukken = sheet1;
afdrukken .= sheet2;
afdrukken .=sheet3

ThisWorkbook.Sheets(Array("afdrukken")).Select

 

[emielDS]

 voorbeeldbestand vergeten?

 en wat moet er met die array gebeuren? gewoon selecteren?

[Pas Cal]

Hierbij een voorbeeldje. Op Blad1 kan je opgeven de naam die de PDF moet krijgen (B1). Blad2 moet altijd naar PDF omgezet worden. Blad3 en Blad4 afhankelijk of in cel B2/B3 Ja of Nee staat -> bij Ja wel en bij Nee niet. 

Het kan zijn dat het aantal Bladen (sheets) nog uitgebreid wordt met Blad5/Blad6 enz.

In het VBA script kan deed ik het zo:

Blad3toevoegen = Sheets("Blad1").Range("B2").Value

If Blad3toevoegen = "" Then
MsgBox "Maak een keuze om blad3 wel/niet mee te printen."
Exit Sub
End If

If Blad3toevoegen = "Nee" Then
ThisWorkbook.Sheets(Array("Blad2")).Select
End If


If Blad3toevoegen = "Ja" Then
ThisWorkbook.Sheets(Array("Blad2", "Blad3")).Select
End If

Maar nu met Blad4 (en eventueel blad 5/6/7) kan dat niet meer. Is hiervoor een oplossing? Dat het script kijkt welke Bladen op 'Ja' staan en deze toevoegt aan het PDF. In de VBA moet de opslaglocatie van het PDF aangepast worden als je het wilt gebruiken.

Export PDF.xlsm

[bakerman]

Eentje om te testen.

 

Sub PrintSelectionToPDF()
    Dim arTmp, shPDF()
    Dim j As Long, i As Long, naam As String
    With Sheets("Blad1")
        arTmp = .Cells(1).CurrentRegion: naam = .Range("B1").Value
        ReDim shPDF(1 To Application.CountIf(.Range("B:B"), "Ja") + 1)
    End With
    shPDF(1) = "Blad2": j = 2
    For i = 2 To UBound(arTmp)
        If arTmp(i, 2) = "Ja" Then
            shPDF(j) = arTmp(i, 1): j = j + 1
        End If
    Next i
    Sheets(shPDF).Select
    ActiveSheet.ExportAsFixedFormat 0, "C:\Users\*******\" & naam
    Application.Goto Sheets("Blad1").Range("A1"), True
End Sub

 

[bakerman]

Vergeten te vermelden dat je op Blad1 het ':' moet verwijderen achter de bladnamen.

 

Wil je deze echter behouden moeten we de code lichtjes aanpassen.

[Pas Cal]

Super dank. Dit is precies wat ik bedoelde! Nogmaals dank!

 

3 uren geleden, bakerman zei:

Eentje om te testen.

 

Sub PrintSelectionToPDF()
    Dim arTmp, shPDF()
    Dim j As Long, i As Long, naam As String
    With Sheets("Blad1")
        arTmp = .Cells(1).CurrentRegion: naam = .Range("B1").Value
        ReDim shPDF(1 To Application.CountIf(.Range("B:B"), "Ja") + 1)
    End With
    shPDF(1) = "Blad2": j = 2
    For i = 2 To UBound(arTmp)
        If arTmp(i, 2) = "Ja" Then
            shPDF(j) = arTmp(i, 1): j = j + 1
        End If
    Next i
    Sheets(shPDF).Select
    ActiveSheet.ExportAsFixedFormat 0, "C:\Users\*******\" & naam
    Application.Goto Sheets("Blad1").Range("A1"), True
End Sub

 

 

[Pas Cal]

Toch nog 1 vraagje. 
Nu staat de sheetnaam + Ja/Nee in kolom A/B. Als ik deze bv in kolom C/D wil hebben (vanaf regel 1) wat moet ik dan wijzigen?

[bakerman]

Hangt er vanaf. Blijven kolommen B en E dan leeg ?

[Pas Cal]

Blijven niet leeg, er kan andere informatie in staan, maar geen info om het VBA script aan te sturen.

[bakerman]

Sub PrintSelectionToPDF()
    Dim arTmp, shPDF()
    Dim j As Long, i As Long, naam As String
    With Sheets("Blad1")
        arTmp = .Range("C1", .Range("C" & .Rows.Count).End(xlUp)).Resize(, 2): naam = .Range("D1").Value
        ReDim shPDF(1 To Application.CountIf(.Range("D:D"), "Ja") + 1)
    End With
    shPDF(1) = "Blad2": j = 2
    For i = 2 To UBound(arTmp)
        If arTmp(i, 2) = "Ja" Then
            shPDF(j) = arTmp(i, 1): j = j + 1
        End If
    Next i
    Sheets(shPDF).Select
    ActiveSheet.ExportAsFixedFormat 0, "C:\Users\*******\" & naam
    Application.Goto Sheets("Blad1").Range("A1"), True
End Sub

 

21 mei 2021 aangepast door bakerman