PDF maken van een bereik via VBA

[luibak]

Beste forum gebruikers,

Voor mijn werk gebruiken wij de onderstaande code om een pdf te maken van een afdrukbereik.
Toen wij maar 1 bereikhadden werkte deze goed maar nu willen wij 2 tabbladden als het waren samen voegen.
Deze dienen wel apart geprint te kunnen worden de marco.
Voor zo ver ik kan zien maakt hij een pdf van het afdrukbereik is het mogelijk dat hij een pdf maakt van een bereik dus 2 macro 1 voor afdrukbereik 1 en de ander voor afdrukbereik 2.
Het enigste wat ik wil weten hoe ik de odnerstaande code kan uitbereiden met een afdrukbereik(die ik dus zelf kan wijzigen.)

Sub SavetoPDFMeerwerk()
'
' SavetoPDF Macro
' De macro is gemaakt op 16-1-2012 door MWE.
' Opslaan als PDF!

'
    If Application.Version = "11.0" Then
    GoTo ErrHandler1
    End If
    
    Application.ScreenUpdating = False
    
    Meerwerk = (Range("BS403").Value)
    Omschrijving = (Range("BO409").Value)
    MyPath = ActiveWorkbook.Path
    
    PDFName = MyPath & "\" & Meerwerk & " " & Omschrijving & ".pdf"
        
    MsgBox "Het PDF bestand wordt hier opgeslagen: " & (Chr(13)) & (Chr(13)) & PDFName & (Chr(13)) & (Chr(13)) & "Als het bestand al bestaat zal deze worden overschreven!"
    
         On Error GoTo ErrHandler2:
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
    PDFName, Quality _
    :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
    
    Application.ScreenUpdating = True
    
Exit Sub
ErrHandler1:
        Application.ScreenUpdating = True
    MsgBox "                                                                   Momenteel draai je Excel 2003." & (Chr(13)) & (Chr(13)) & "                                                 Deze functie wordt pas ondersteund vanaf Excel 2007."
Exit Sub
ErrHandler2:
        Application.ScreenUpdating = True
    MsgBox "Het bestand kan niet worden opgeslagen controleer of het bestand al bestaat en is geopend." & (Chr(13)) & (Chr(13)) & "Het kan ook zijn dat de totale bestandsnaam te lang is, verkort in dat geval de naam van je bestand."
    

End Sub

 

[spaarie]

Ik, in ieder geval, snap hem niet helemaal...
Wil je nou van 2 afdrukbereiken op 2 verschillende tabbladen samenvoegen naar 1 afdrukbereik?

Is dit een oplossing?

Sub Spaarie()
    MsgBox "Het PDF bestand wordt hier opgeslagen: " & vbLf & _
            vbLf & ThisWorkbook.Path & "\" & Sheets(1).Range("BS403") & " " & Sheets(1).Range("BO409") & ".pdf" & vbLf & _
            vbLf & "Als het bestand al bestaat zal deze worden overschreven!"
            
    Sheets(Array("Blad1", "Blad2")).Copy
    ActiveWorkbook.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Sheets(1).Range("BS403") & " " & Sheets(1).Range("BO409") & ".pdf"
    ActiveWorkbook.Close False
    
    Kill ThisWorkbook.Path & "\" & Sheets(1).Range("BS403") & " " & Sheets(1).Range("BO409") & ".pdf"
End Sub

Hiermee kan je de 2 tabbladen uit een grotere werkboek opslaan als PDF.

 

[luibak]

Spaarie,

Misschien was het niet helemaal duidelijk hoe ik het omschreef.

Ik wil de macro die ik heb zo ombouwen dat hij een speciefiek bereik afdrukt omdat er 2 verschillende stukken zijn.
Aangezien er rijen aan toegevoegd kunnen worden wilde ik dit via een bereik doen.

nu werkt de code wel bij het ene stuk maar omdat ej maar 1 afdrukbereik kan hebben doet hij het dus niet bij het andere stuk.

luibak

 

[spaarie]

Bedankt voor de verduiding ?????

Je wilt dus zelf je afdrukbereik bepalen?
Het is niet je oplossing, maar brengt je misschien op ideeën:

Sub Spaarie()
    bereik1 = InputBox("Vanaf welke cel wil je afdrukken?")
    bereik2 = InputBox("Tot welke cel wil je afdrukken?")
    
    With Sheets(1)
        .PageSetup.PrintArea = bereik1 & ":" & bereik2
        .PrintOut
    End With
End Sub

 

[luibak]

We zullen maar zeggen 3 maal scheepsrecht.
Er zijn 2 verschillende bereiken in 1 tabblad die ik onafhankelijke van elkaar wil printen doormiddel van de bovenstaande macro.
Aangezien je in die macro niet kan aangeven dat hij bereik 1 of 2 moet pakken vroeg ik mij af hoe je deze kon uitbreiden met dat.

 

[spaarie]

Laten we het hopen

Sub Spaarie()
    MsgBox "Het PDF bestand wordt hier opgeslagen: " & vbLf & _
            vbLf & ThisWorkbook.Path & "\" & Sheets(1).Range("BS403") & " " & Sheets(1).Range("BO409") & ".pdf" & vbLf & _
            vbLf & "Als het bestand al bestaat zal deze worden overschreven!"
            
    bereik = InputBox("Welk bereik wilt u printen?" & vbLf & _
                      "(Geef cijer 1 of 2 in)")
    If bereik = "" Then
        MsgBox "Dit is ongeldig, opdracht wordt geannuleerd.", vbInformation, "Ongeldig"
    Else
        If bereik = 1 Then
            With Sheets(1) 'stel hier je desbetreffende sheet in
                .PageSetup.PrintArea = "A1:C20" 'stel hier afdrukbereik1 in
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Sheets(1).Range("BS403") & " " & Sheets(1).Range("BO409") & ".pdf"
            End With
        Else
            With Sheets(1) 'stel hier de desbetreffende sheet in
                .PageSetup.PrintArea = "E1:G20" 'stel hier afdrukbereik2 in
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Sheets(1).Range("BS403") & " " & Sheets(1).Range("BO409") & ".pdf"
            End With
        End If
    End If
End Sub

 

[luibak]

Spaarie,

Heel erg bedankt voor je hulp maar ik heb het anders opgelost.

Door het toevoegen van

  ActiveSheet.PageSetup.PrintArea = "Afdrukbereik2"

Doet hij wat ik wil. Afdrukbereik2 is een bereik wat dus mee veranderd als je rijen invoegd etc.