Macro exporteert 2 werkbladen als PDF naar schijf

[Sportman1975]

Beste allen,

de volgende uitdaging heb ik mij op de hals gehaald maar loop nu vast. Heb getracht het zo netjes mogelijk te doen maar helaas.
Ik heb 4 tabbladen (Info/Samenvatting/Generiek/Parallel). Ik heb al een macro welke uit samenvatting een export maakt naar de tabbladen generiek en parallel. Nu wil ik echter dat de volgende macro een export maakt van deze 2 tabbladen (alleen de actieve velden (afdrukbereik)) in PDF. Zou iemand mij behulpzaam kunnen zijn?

Sub Mailtest()
Dim pdfName As String, FolderName As String, FullName As String
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

pdfName = Worksheet("Info").Range("B7").Text
FolderName = Worksheet("Info").Range("H17").Text
FullName = "D:\Invoices\" & FolderName & "\" & pdfName & ".pdf"

Set ws1 = ThisWorkbook.Sheets("Info")
Set ws2 = ThisWorkbook.Sheets("Parallel")
Set ws3 = ThisWorkbook.Sheets("Generiek")


ws2LR = ws2.Cells(Rows.Count, 1).End(xlUp).Row
ws2LC = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
ws3LR = ws3.Cells(Rows.Count, 1).End(xlUp).Row
ws3LC = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

Set printA = ws2.Range("a1:" & ws2LC & ws2LR)
Set printB = ws3.Range("a1:Z" & ws3LR)

If MsgBox("Please confirm that name and location is correct: " & FullName & ".  -  " & " Is it correct?", vbYesNo + vbQuestion, "Confirm File Name and Location") = vbNo Then Exit Sub
printA.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName _
, Quality:=xlQualityMedium, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

YesNo = MsgBox("Would you like to open the folder where the invoice was saved?" _
, vbYesNo + vbQuestion, "Open Folder?")
Select Case YesNo
Case vbYes
myval = Shell("explorer D:\Invoices\" & FolderName, 1)
Case vbNo
End Select


End Sub

Function DirExists(sSDirectory As String) As Boolean
If Dir(sSDirectory, vbDirectory) <> "" Then DirExists = True
End Function

 

[Warme bakkertje]

Moeten ze beiden in 1 pdf of in 2 aparte ?
In het 1ste geval zou ik beide bereiken naar een tijdelijk aangemaakt werkblad kopiëeren en dit dan opslaan als pdf, daarna het tijdelijk werkblad verwijderen.

 

[Sportman1975]

2 aparte......
Maar kun je helpen met de visual basic?

 

[Warme bakkertje]

Sub Mailtest()
    Dim pdfNameA As String, pdfNameB As String, FolderName As String
    Dim FullNameA As String, FullNameB As String
    
    With Sheets("Info")
        pdfNameA = .Range("B7").Value
        pdfNameB = .Range("??").Value 'hier nog de juiste range invullen
        FolderName = .Range("H17").Value
        FullNameA = "D:\Invoices\" & FolderName & "\" & pdfNameA & ".pdf"
        FullNameB = "D:\Invoices\" & FolderName & "\" & pdfNameB & ".pdf"
    End With
    
    If MsgBox("Please confirm that names and locations are correct: " & vbLf & FullNameA & vbLf & FullNameB & vbLf & " Is it correct?", _
        vbYesNo + vbQuestion, "Confirm File Name and Location") = vbNo Then Exit Sub
    
    With Sheets("Parallel")
        ws2LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        ws2LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1), .Cells(ws2LR, ws2LC)).ExportAsFixedFormat 0, FullNameA
    End With
    
    With Sheets("Generiek")
        ws3LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1), .Cells(ws3LR, 26)).ExportAsFixedFormat 0, FullNameB
    End With

    If MsgBox("Would you like to open the folder where the invoices were saved?", _
            vbYesNo + vbQuestion, "Open Folder?") = vbYes Then
        myval = Shell("explorer D:\Invoices\" & FolderName, 1)
    End If
End Sub

 

[Sportman1975]

Beste Rudi,

dank voor je snelle reactie!
Echter ik krijg een foutmelding bij de uitvoer van de macro:
Fout -2147024773 (8007007b) tijdens uitvoering: Het document is niet opgeslagen.
Bij de foutopsporing geeft hij aan dat het om de volgende regel gaat:
.Range(.Cells(1), .Cells(ws2LR, ws2LC)).ExportAsFixedFormat 0, FullNameA

Sub Mailtest()
    Dim pdfNameA As String, pdfNameB As String, FolderName As String
    Dim FullNameA As String, FullNameB As String
    
    With Sheets("Info")
        pdfNameA = .Range("f14").Value
        pdfNameB = .Range("f15").Value 'hier nog de juiste range invullen
        FolderName = .Range("H17").Value
        FullNameA = "D:\Invoices\" & pdfNameA & ".pdf"
        FullNameB = "D:\Invoices\" & pdfNameB & ".pdf"
    End With
    
    If MsgBox("Please confirm that names and locations are correct: " & vbLf & FullNameA & vbLf & FullNameB & vbLf & " Is it correct?", _
        vbYesNo + vbQuestion, "Confirm File Name and Location") = vbNo Then Exit Sub
    
    With Sheets("Parallel")
        ws2LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        ws2LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1), .Cells(ws2LR, ws2LC)).ExportAsFixedFormat 0, FullNameA
    End With
    
    With Sheets("Generiek")
        ws3LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1), .Cells(ws3LR, 26)).ExportAsFixedFormat 0, FullNameB
    End With

    If MsgBox("Would you like to open the folder where the invoices were saved?", _
            vbYesNo + vbQuestion, "Open Folder?") = vbYes Then
        myval = Shell("explorer D:\Invoices", 1)
    End If
End Sub

 

[Warme bakkertje]

Meer dan waarschijnlijk staan er ongeldige tekens in Range F14 zodat je een ongeldige naam krijgt.
Heb zelf even testbestandje gemaakt en bereik wordt perfect opgeslagen, dus aan de code ligt het zeker niet.