Ga naar inhoud

Genereren PDF dmv Excel VBA


Pas Cal

Aanbevolen berichten

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

 

Link naar reactie
Delen op andere sites

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

Link naar reactie
Delen op andere sites

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

 

Link naar reactie
Delen op andere sites

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

 

 

Link naar reactie
Delen op andere sites

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

 

aangepast door bakerman
Link naar reactie
Delen op andere sites

×
×
  • Nieuwe aanmaken...

Belangrijke informatie

We hebben cookies geplaatst op je toestel om deze website voor jou beter te kunnen maken. Je kunt de cookie instellingen aanpassen, anders gaan we er van uit dat het goed is om verder te gaan.