VBA PDF printen meerdere bladen met bepaalde naam in Sheet

Status
Niet open voor verdere reacties.
R

royb73

Gebruiker
Lid geworden
19 sep 2012
Berichten
228
Beste mensen,

Ik heb even hulp nodig.

Ben bezig om een code te maken, waarbij er 1 PDF aangemaakt moet worden van verschillende sheets (Excel) met een bepaalde naam in de sheet. In het voorbeeld hieronder is de xxxx variabel. In dit voorbeeld zou er 1 PDF aangemaakt moeten worden van alle sheets, waar het woord "Huurder" in voorkomt.

Code: 
        If BladBestaat("Huurders_xxxx") = True Then
    'Totaal overzicht
    Worksheets("Huurders_%").ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"
    PDFgemaakt = True
    Else
    MsgBox "Blad huurdersoverzichten niet gevonden. Controleer dit en probeer opnieuw."
    Exit Sub
    End If

Wie o wie kan mij helpen?

Alvast bedankt.

Met vriendelijke groet,

Roy
 
Komt dat niet omdat je eerst 'Exit Sub doet en daarna pas End If?
 
Beste Royzilla,

Ik heb alleen een gedeelte van de code toegevoegd. In feite is de code langer. Alleen dit stukje lukt mij niet. Ik heb namelijk ook de codes die PDF aanmaakt van 1 blad. Dit is makkelijk, omdat ik alleen de naam van de sheet hoeft in te vullen "xxx". Nu heb ik meerdere sheets, die als 1 PDF samengevoegd moeten worden, waarbij het woord "Huurder" (= sheetnaam) in voorkomt.

Mvg

Roy
 
Dan snap ik nog steeds niet waarom dat zo staat.
Mocht dat niet het probleem zijn hoop ik wel dat een ander je verder kan helpen met deze macro.
 
Beste Royzilla,

Ik zet even voor het gemak de hele code. Misschien is het dan iets duidelijker.


Code: 
Sub MaakPDFs()
    Dim OutName As String, OutPath As String, PDFgemaakt As Boolean
    
    OutPath = ActiveWorkbook.Path & "\Definitief\"
    OutName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
 
  
    If (Dir(OutPath, vbDirectory) = "") Then
    MsgBox ("De map \Definitief\ bestaat niet in het pad:" & vbCrLf & ActiveWorkbook.Path & _
    vbCrLf & "Controleer dit en maak dit aan via de verkenner.")
        Exit Sub
    End If
        
    If BladBestaat("Totaal overzicht") = True Then
    'Totaal overzicht
    Worksheets("Totaal overzicht").ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_t.pdf"
    PDFgemaakt = True
    Else
    MsgBox "Blad Totaal overzicht niet gevonden. Controleer dit en probeer opnieuw."
    Exit Sub
    End If
    
    If BladBestaat("Totaal overzicht2") = True Then
    'Overzicht K
    Worksheets("Totaal Huurders overzicht").ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_o.pdf"
    'ActiveWorkbook.Worksheets("Overzicht huurders_K").Copy
    'ActiveWorkbook.ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_o.pdf"
    'ActiveWorkbook.Close False
    PDFgemaakt = True
    Else
    MsgBox "Blad Overzicht huurders_K niet gevonden. Controleer dit en probeer opnieuw."
    Exit Sub
    End If
    
[COLOR="#FF0000"][B][COLOR="#000000"]Bij de volgende code gaat het niet goed! Hier zijn meerdere tabbladen van, die dan als 1 PDF gemaakt dient te worden.[/COLOR][/B][/COLOR]
        If BladBestaat("Huurders_xxx") = True Then
    'Totaal overzicht
    Worksheets("Huurders_xxx").ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"
    'ActiveWorkbook.Worksheets("Totaal overzicht").Copy
    'ActiveWorkbook.ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_t.pdf"
    'ActiveWorkbook.Close False
    PDFgemaakt = True
    Else
    MsgBox "Blad huurdersoverzichten niet gevonden. Controleer dit en probeer opnieuw."
    Exit Sub
    End If
    
   If PDFgemaakt Then
        MsgBox "PDF's zijn gemaakt en opgeslagen in " & OutPath
    Else
        MsgBox "Niet alle PDF's zijn gemaakt"
    End If
    
    Shell "explorer.exe" & " " & OutPath, vbNormalFocus

Hoop dat het beetje duidelijk is nu.

Mvg

Roy
 
Probeer het eens zo:

Code: 
Sub tst()
    Dim hgv As Boolean
    Dim i As Integer
    
    For i = 1 To Worksheets.Count
        If Left(Worksheets(i).Name, 9) = "Huurders_" Then
            hgv = True
            'Totaal overzicht
            Worksheets(i).ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"
            PDFgemaakt = True
        End If
    Next i
    
    If Not hgv Then
        MsgBox "Blad huurdersoverzichten niet gevonden. Controleer dit en probeer opnieuw."
        Exit Sub
    End If
End Sub
 
Beste Edmoor,

Bedankt voor jouw reactie.

Ik kom nu een heel eind. Alleen is het probleem dat hij niet alle sheets samenvoegt tot 1 PDF die met "Huurders " begint. Indien de PDF is aangemaakt, zie ik 1 blad in de PDF bestand staan.

Hoe krijg ik voor mekaar dat alle sheets met de naam "huurders " tot 1 PDF bestand wordt samengevoegd?

Mvg

Roy.
 
Dat zou je dan zo kunnen doen. Bouw een array van bladnamen die je selecteert en exporteer de selectie naar PDF:

Code: 
Sub tst()
    Dim hgv As Boolean
    Dim i As Integer
    Dim p As Integer
    Dim acs As String
    Dim toPDF() As String
    
    acs = ActiveSheet.Name
    For i = 1 To Worksheets.Count
        If Left(Worksheets(i).Name, 9) = "Huurders_" Then
            ReDim Preserve toPDF(p)
            toPDF(p) = Worksheets(i).Name
            p = p + 1
            hgv = True
        End If
    Next i
    
    If hgv Then
        'Totaal overzicht
        Sheets(toPDF).Select
        Selection.ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"
        PDFgemaakt = True
    Else
        MsgBox "Blad huurdersoverzichten niet gevonden. Controleer dit en probeer opnieuw."
        Exit Sub
    End If
    
    Sheets(acs).Select
End Sub
 
Laatst bewerkt:
Beste Edmoor,

Nu krijg ik wel 2 bladen met "Huurders ", echter zijn de bladen leeg in de PDF? De inhoud van de bladen wordt niet overgenomen in de PDF.

Kennelijk iets niet goed in de code?

Mvg
Roy
 
Het werkt hier prima dus wat er dan aan de hand is kan ik zo niet zeggen.
 
BEste Edmoor,

Ik stuur de hele module mee. Voor alle duidelijkheid, alle bladen worden aangemaakt en op de juiste locatie opgeslagen. Alleen word het blad "Huurders " die uit meerdere sheets bestaat, ge-PDFt, maar zonder inhoud.


Code: 
Sub MaakPDFs()
    Dim OutName As String, OutPath As String, PDFgemaakt As Boolean
    Dim i As Integer
    Dim hgv As Boolean
    Dim p As Integer
    Dim acs As String
    Dim toPDF() As String
    
    OutPath = ActiveWorkbook.Path & "\4 Aangeleverd aan OG\Definitief\"
    OutName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
 
    MsgBox "Huidig padnaam is: " & _
    ActiveWorkbook.Path
 
    MsgBox "Huidig MC nummer is: " & _
    OutName
    
    Application.ScreenUpdating = False
        
    If (Dir(OutPath, vbDirectory) = "") Then
    MsgBox ("De map \4 Aangeleverd aan OG\Definitief\ bestaat niet in het pad:" & vbCrLf & ActiveWorkbook.Path & _
    vbCrLf & "Controleer dit en maak dit aan via de verkenner.")
        Exit Sub
    End If
        
    If BladBestaat("Totaal overzicht") = True Then
    'Totaal overzicht
    Worksheets("Totaal overzicht").ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_t.pdf"
    PDFgemaakt = True
    Else
    MsgBox "Blad Totaal overzicht niet gevonden. Controleer dit en probeer opnieuw."
    Exit Sub
    End If
    
    If BladBestaat("Totaal Huurders overzicht") = True Then
    'Overzicht K
    Worksheets("Totaal Huurders overzicht").ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_o.pdf"
    ActiveWorkbook.Worksheets("Gegevens").Select
    PDFgemaakt = True
    Else
    MsgBox "Blad Overzicht huurders_K niet gevonden. Controleer dit en probeer opnieuw."
    Exit Sub
    End If
    
    
    acs = ActiveSheet.Name
    For i = 1 To Worksheets.Count
        If Left(Worksheets(i).Name, 9) = "Huurders " Then
            ReDim Preserve toPDF(p)
            toPDF(p) = Worksheets(i).Name
            p = p + 1
            hgv = True
            'Huurders overzicht
            Sheets(toPDF).Select
            Selection.ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"
            PDFgemaakt = True
        End If
    Next i
    Sheets(acs).Select
    
    If Not hgv Then
        MsgBox "Blad huurdersoverzichten niet gevonden. Controleer dit en probeer opnieuw."
        Exit Sub
    End If

  
    Application.ScreenUpdating = True
    
    If PDFgemaakt Then
        MsgBox "PDF's zijn gemaakt en opgeslagen in " & OutPath
    Else
        MsgBox "Niet alle PDF's zijn gemaakt"
    End If
    
    Shell "explorer.exe" & " " & OutPath, vbNormalFocus
    
End Sub
 
Kijk nog eens naar de code zoals ik deze heb geplaatst. Kennelijk heb je er een kopie van gemaakt voordat ik ermee klaar was.
Mijn schuld, had ik het maar direct goed moeten doen :eek:
 
Beste Edmoor,

Ik krijg een fout bij deze zin:

Selection.ExportAsFixedFormat xlTypePDF, ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"

Als ik hier ExportAsFixedFormat xlTypePDF verwijder, dan gaat het wel goed, maar dan krijg ik nog steeds blanco sheets.

Mvg

Roy
 
Kennelijk iets mis gegaan met het plakken van de code. Die regel moet als volgt zijn:
Selection.ExportAsFixedFormat xlTypePDF, OutPath & OutName & "_ho.pdf"

Het zit me niet mee vanavond ;)
Maar de blanco sheets begrijp ik nog steeds niet.
 
Laatst bewerkt:
Om 1 of andere reden zijn de bladen bij mij nu ook leeg. Heel vreemd, maar ik ga zoeken.
 
Beste Edmoor,

Ik stuur mijn bestand mee. Ik heb wel waardevolle gegevens verwijderd.

Hoop dat je hier uitkomt.

Mvg

Roy
 

Bijlagen

  • Kantoren.xlsm
    43,9 KB · Weergaven: 45
Code: 
ActiveSheet.ExportAsFixedFormat 0, OutPath & OutName & "_ho.pdf"
 
Beste Warme Bakkertje,

Het probleem heeft met jouw code het probleem opgelost.

Vriendelijk bedankt.

Mvg

Roy
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan