2x een range printen naar vba

Status
Niet open voor verdere reacties.
J

jolanda05031975

Gebruiker
Lid geworden
7 feb 2014
Berichten
31
Ik heb een mooie factuur welke ik kan printen in PDF, nu heb ik echter mijn factuur moeten aanpassen waarbij ik ook een specificatie van mijn uren heb gemaakt.

De ene pagina is echter liggen en de andere is staan. Nu wil ik graag 2x een range kunnen aangeven waarbij er 2 pdf worden gemaakt.

1x van mijn factuur en 1 van mijn bijlage. Ik krijg dit alleen niet voor elkaar. (nog mooier in 1 pdf natuurlijk, maar dan zit je met je opmaak van liggend en staand volgens mij)

Hoor graag.

Dennis

Dit is mijn script

Code: 
Private Sub Nieuw_Click()
    Range("B18").Value = Date
    Range("B17").Value = Range("B17").Value + 1
    Range("A21:A42").ClearContents
    Range("B21:B42").ClearContents
    Range("D21:D42").ClearContents
    Range("E21:E42").ClearContents
    Range("F21:F42").ClearContents
    
End Sub

Private Sub CommandButton1_Click()
    Dim FACname As String
    Dim KLTnaam As String
    Dim Padnaam As String
    Dim PDFnaam As String

    Padnaam = "P:\Facturen PDF\"
    KLTnaam = Range("D10")
    If KLTnaam = "" Then
        MsgBox "Klantnaam in te vullen."
        Exit Sub
    End If
    
    WKname = Trim(Range("A22"))
    FACname = Trim(Range("B17"))                                       ' De macro haalt met dit command het factuurnummer op in de factuur,
                                                                       ' om deze later als naam voor het PDF-bestand te gebruiken.
    If Dir(Padnaam & FACname & "*.pdf") <> "" Then
        MsgBox "Factuur: " & FACname & " bestaat reeds"                
     Exit Sub                                                      

    Else
        PDFnaam = Padnaam & FACname & " " & KLTnaam & WKname & ".pdf"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=PDFnaam, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            From:=1, _
            To:=1, _
            OpenAfterPublish:=True
    End If
End Sub
 
Laatst bewerkt door een moderator:
Gebruik svp code tags. Het is een beetje lastig lezen op deze manier.
 
VBA / PDF / Instellingen landscape en portrait

Het is me nu gelukt om 2 PDF bestanden er uit te krijgen alleen gaat de tweede pagina nu niet goed omdat ik deze niet horizontaal krijg (landscape) en komt 1 regel mee van het veld A1.

Dit is de code welke ik nu heb
Code: 
Private Sub Opslaan_Click()

    Dim FACname As String
    Dim KLTnaam As String
    Dim Padnaam As String
    Dim PDFnaam As String

    Padnaam = "C:\test\"
    KLTnaam = Range("D10")
    If KLTnaam = "" Then
        MsgBox "Gelieve een klantnaam in te vullen."
        Exit Sub
    End If
    
    WKname = Trim(Range("A22"))
    FACname = Trim(Range("B17"))                                       ' De macro haalt met dit command het factuurnummer op in de factuur,
                                                                       ' om deze later als naam voor het PDF-bestand te gebruiken.
    If Dir(Padnaam & FACname & "*.pdf") <> "" Then
        MsgBox "Factuur: " & FACname & " bestaat reeds"                ' Een controle om geen dubbel PDF-bestand te maken.
                                                                       ' De map waarin je de PDF-bestanden in wilt creëeren ( facturen 2015 )
                                                                       ' moet op voorhand aangemaakt zijn!!
        Exit Sub                                                       ' Verlaat de routine als het PDF-bestand reeds bestaat.
    Else
        PDFnaam = Padnaam & FACname & " " & KLTnaam & WKname & ".pdf"
        
        With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    
        Range("A1:G46").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=PDFnaam, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            From:=1, _
            To:=1, _
            OpenAfterPublish:=True
            
       PDFnaam = Padnaam & FACname & " " & KLTnaam & WKname & " Bijlage.pdf"
    
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
        
        Range("I56:AC100").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=PDFnaam, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            From:=1, _
            To:=1, _
            OpenAfterPublish:=True
            
    End If
    
End Sub
 
Je kan ipv een bestand opslaan als . pdf deze ook laten 'printen' als .pdf. Hoe je het juiste pad en naam erin krijgt weet ik (nog) niet.

Code: 
Sub VenA()
    Range("I56:AC100").Select
    Application.ActivePrinter = "Bullzip PDF Printer op Ne04:"
    ExecuteExcel4Macro _
    "PRINT(1,,,1,,,,,,,,1,""Bullzip PDF Printer op Ne04:"",,TRUE,,FALSE)"
End Sub

Je zal dit wel even moeten aanpassen naar jouw eigen situatie;)
 
Bekijk dit eens:

Code: 
    Dim wsActivesheet As Excel.Worksheet
    Dim sPdfnaam As String
    sPdfnaam = "d:\temp\test.pdf"
    
    With Sheets("Blad1").PageSetup
        .Orientation = xlPortrait
        .PrintArea = "$B$2:$H$4"
    End With
    
    With Sheets("Blad2").PageSetup
        .Orientation = xlLandscape
        .PrintArea = "$B$2:$H$4"
    End With
    
    Set wsActivesheet = ActiveSheet
    Sheets(Array("Blad1", "Blad2")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=sPdfnaam, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    wsActivesheet.Select
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan