Macro for creating pdf with multiple sheets based on cell value in each sheet.

[LEHoisveen]

I'm trying to create an macro for generating a pdf containing multiple sheets, I want all sheets that have A1 = "x" or "X" to be included in the pdf.
I also want the pdf to be saved in \..\..\9 - GENERERTE PDF\ and with the value in call H7 in active sheet to be the file name.

All the sheets are named diferently, they have not the standard names anymore.

I have tried to modify some other macros I have without luck anyone that can help?
Running MS365

 

[DanteAmor]

Trty this:

Sub creating_pdf()
  Dim vsheets()
  Dim sh As Worksheet
  Dim sPath As String, sName As String
  Dim n As Long
 
  sPath = "C:\trabajo\"       'fit to \..\..\9 - GENERERTE PDF\
  sName = "filename.pdf"  'fit the name of the pdf file
 
  For Each sh In Sheets
    If UCase(sh.Range("A1").Value) = "X" Then
      ReDim Preserve vsheets(n)
      vsheets(n) = sh.Name
      n = n + 1
    End If
  Next
 
  If n > 0 Then
    Sheets(vsheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=False
    Sheets(1).Select
  Else
    MsgBox "There are no sheets with the mark"
  End If
End Sub

 

[LEHoisveen]

Thanks, but it came out with an error.

 

[DanteAmor]

'fit to \..\..\9 - GENERERTE PDF\

But you must put a path that exists on your computer, something like "C:\files\9 - GENERERTE PDF\"
Must include drive and a folder that exists on your computer

".." is not a folder.

I mean the macro is not resolving that path.
Or try the following macro, don't change anything in the code. The file will be saved in the same folder where you have the file with the macro:

Sub creating_pdf()
  Dim vsheets()
  Dim sh As Worksheet
  Dim sPath As String, sName As String
  Dim n As Long
  
  sPath = ThisWorkbook.Path & "\"
  sName = "filename.pdf"
  
  For Each sh In Sheets
    If UCase(sh.Range("A1").Value) = "X" Then
      ReDim Preserve vsheets(n)
      vsheets(n) = sh.Name
      n = n + 1
    End If
  Next
  
  If n > 0 Then
    Sheets(vsheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=False
    Sheets(1).Select
  Else
    MsgBox "There are no sheets with the mark"
  End If
End Sub

 

[LEHoisveen]

I see I was missing a \ in front.. all my other macros are pointing to \..\..\9 - GENERERTE PDF\ and i have no issuse with them, I cant figure out whats wrong.

 

[DanteAmor]

all my other macros are pointing to \..\..\9 - GENERERTE PDF\

You can put an example of one of your macros, that is, put one of your macros here.

I cant figure out whats wrong.

Check where you have saved the file with the macro.
Two directories down you should have a folder with the name: "9 - GENERERTE PDF" (I guess)
---- --
But before continuing to test the folder, I suggest you try the macro in post #4, so you can check that it is saving the sheets that have the "x" mark in a single PDF file.

 

[LEHoisveen]

I tried the code in post 4, and it works
So now is the issue to get it saved where i need it to be

Here are one of the other macros that works, saving in the correct place.

Sub EKSPORT_AVTALE()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
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 = ActiveSheet
strTime = Format(Now(), "ddmmyyyy\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\..\..\9 - GENERERTE PDF\Avtaler\"

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

'create default name for saving the file
'strFile = "Leveringsavtale med  " & Range("I4").Value & " - " & Range("I5").Value & " - " & Range("G97").Value & ".pdf"
strFile = Range("J6").Value & " - " & "Org.nr. " & Range("J5").Value & " - " & Range("h115").Value & " - Leveringsavtale.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 er opprettet: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Kunne ikke opprette PDF"
    Resume exitHandler
End Sub

 

[LEHoisveen]

I got it working Thanks for your help
Here are the working code:

Sub creating_pdf()
  Dim vsheets()
  Dim sh As Worksheet
  Dim sPath As String, sName As String
  Dim n As Long
 
  sPath = ThisWorkbook.Path & "\..\..\9 - GENERERTE PDF\"
  sName = Range("H7").Value & " - " & Range("J25").Value & " - ForhandlerPerm.pdf"
 
  For Each sh In Sheets
    If UCase(sh.Range("A1").Value) = "X" Then
      ReDim Preserve vsheets(n)
      vsheets(n) = sh.Name
      n = n + 1
    End If
  Next
 
  If n > 0 Then
    Sheets(vsheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=False
    Sheets(1).Select
  Else
    MsgBox "There are no sheets with the mark"
  End If
End Sub

 

[DanteAmor]

Here are one of the other macros that works, saving in the correct place.

In that macro you have, so to speak, the initial path:

strPath = strPath & "\..\..\9 - GENERERTE PDF\Avtaler\"

But later in these instructions you change that "initial path" to what you select.

  myFile = Application.GetSaveAsFilename _
      (InitialFileName:=strPathFile, _
          FileFilter:="PDF Files (*.pdf), *.pdf", _
          Title:="Select Folder and FileName to save")

So you can do the same:

Sub creating_pdf()
  Dim wbA As Workbook
  Dim vsheets()
  Dim sh As Worksheet
  Dim strPath As String, strFile As String, strPathFile As String
  Dim n As Long
  Dim myFile As Variant
  
  Set wbA = ActiveWorkbook
  'get active workbook folder, if saved
  strPath = wbA.Path
  If strPath = "" Then
    strPath = Application.DefaultFilePath
  End If
  strPath = strPath & "\..\..\9 - GENERERTE PDF\Avtaler\"
  
  strFile = "filename.pdf"
  strPathFile = strPath & strFile
  
  myFile = Application.GetSaveAsFilename _
      (InitialFileName:=strPathFile, _
          FileFilter:="PDF Files (*.pdf), *.pdf", _
          Title:="Select Folder and FileName to save")
  
  For Each sh In Sheets
    If UCase(sh.Range("A1").Value) = "X" Then
      ReDim Preserve vsheets(n)
      vsheets(n) = sh.Name
      n = n + 1
    End If
  Next
  
  If n > 0 Then
    Sheets(vsheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=False
    Sheets(1).Select
  Else
    MsgBox "There are no sheets with the mark"
  End If
End Sub

 

[DanteAmor]

I got it working Thanks for your help

I'm glad to hear that.
Im glad to help you. Thanks for the feedback.