VBA multiple Sheets to pdf

[MatthiasPBelmans]

Hoi

Ik zou graag van een Excel-bestand met meerdere sheets een pdf maken.
Ik heb onderstaande VBA gevonden en deze werkt goed als ik 1 sheet kies.
Zodra ik een array van sheets kies, wilt deze niet werken..

Ik ben nogal nieuw in VBA dus kan iemand me helpen?

VBA:
Sub PDFActiveSheet()

Dim wsA As Worksheets
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = Sheets(Array("commercial invoice", "shipping advice"))
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & ""

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

 

[lam201]

Je declareert wsA als Worksheet.
maar vervolgens wijs je een array toe aan wsA
Daar gaat ie fout op.

zo kan het wel

Sub L201()

SheetArray = Array("commercial invoice", "shipping advice")

varFileName = ActiveWorkbook.Path & "\" & "test.pdf"

With Sheets(SheetArray)

        .Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=varFileName, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True

End With
End Sub

 

[cow18]

die wsA levert problemen op, je declareert die als worksheets

Sub PDFActiveSheet()

[COLOR="#FF0000"]'Dim wsA As Sheets[/COLOR]
   Dim wbA     As Workbook
   Dim strTime As String
   Dim strName As String
   Dim strPath As String
   Dim strFile As String
   Dim strPathFile As String
   Dim myFile  As Variant
   On Error GoTo errHandler

   Set wbA = ActiveWorkbook
  [COLOR="#FF0000"] arr = Array("commercial invoice", "shipping advice")
   Set wsA = Sheets(arr)
   wsA.Select[/COLOR]
   strTime = Format(Now(), "yyyymmdd\_hhmm")

   'get active workbook folder, if saved
   strPath = wbA.Path
   If strPath = "" Then
      strPath = Application.DefaultFilePath
   End If
   strPath = strPath & ""

   'replace spaces and periods in sheet name
  [COLOR="#FF0000"] strName = Replace(Replace(Join(arr), " ", ""), ".", "_")
[/COLOR]
   'create default name for savng file
   strFile = strName & "_" & strTime & ".pdf"
   strPathFile = strPath & strFile

   'use can enter name and
   ' select folder for file
   myFile = Application.GetSaveAsFilename _
            (InitialFileName:=strPathFile, _
             FileFilter:="PDF Files (*.pdf), *.pdf", _
             Title:="Select Folder and FileName to save")

   'export to PDF if a folder was selected
   If myFile <> "False" Then
      [COLOR="#FF0000"]ThisWorkbook[/COLOR].ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
      'confirmation message with file info
      MsgBox "PDF file has been created: " _
             & vbCrLf _
             & myFile
   End If

exitHandler:
   Exit Sub
errHandler:
   MsgBox "Could not create PDF file"
   Resume exitHandler
End Sub

 

[MatthiasPBelmans]

Hey tx die werkt perfect @cow18,
Nu nog een ander vraag:

de file naam zou die moeten halen uit Sheet "Data input" cel D34, hoe kan ik dit het beste doen?

 

[cow18]

een variant op ... (hopelijk staan er geen verboden karakters in die cel)

 strFile = sheets("Data input").range("D34").value & "_" & strName & "_" & strTime & ".pdf"

 

[MatthiasPBelmans]

tx Cow! Dit werkt perfect!

 

[MatthiasPBelmans]

Hoi

Ik heb nu de volgende code gebruikt
Maar nu is het probleem dat er een PDF wordt gecreeërd met ALLE tabbladen, niet alleen mijn geselecteerde bladen

Sub PDFActiveSheet()

'Dim wsA As Sheets
   Dim wbA     As Workbook
   Dim strTime As String
   Dim strName As String
   Dim strPath As String
   Dim strFile As String
   Dim strPathFile As String
   Dim myFile  As Variant
   On Error GoTo errHandler

   Set wbA = ActiveWorkbook
   arr = Array("commercial invoice", "shipping advice")
   Set wsA = Sheets(arr)
   wsA.Select
   strTime = Format(Now(), "yyyymmdd\_hhmm")

   'get active workbook folder, if saved
   strPath = wbA.Path
   If strPath = "" Then
      strPath = Application.DefaultFilePath
   End If
   strPath = strPath & ""

   'replace spaces and periods in sheet name
   strName = Replace(Replace(Join(arr), " ", ""), ".", "_")

   'create default name for savng file
   strFile = strName & "_" & strTime & ".pdf"
   strPathFile = strPath & strFile

   'use can enter name and
   ' select folder for file
   myFile = Application.GetSaveAsFilename _
            (InitialFileName:=strPathFile, _
             FileFilter:="PDF Files (*.pdf), *.pdf", _
             Title:="Select Folder and FileName to save")

   'export to PDF if a folder was selected
   If myFile <> "False" Then
      ThisWorkbook.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
      'confirmation message with file info
      MsgBox "PDF file has been created: " _
             & vbCrLf _
             & myFile
   End If

exitHandler:
   Exit Sub
errHandler:
   MsgBox "Could not create PDF file"
   Resume exitHandler
End Sub

Kan iemand mij hier mee helpen?

 

[cow18]

gokje

  'export to PDF if a folder was selected
   If myFile <> "False" Then
      [COLOR="#FF0000"]ActiveSheet[/COLOR].ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _