VBA Code to create pdf and name it based on criteria

[jdhfch]

Hi there,

I am wanting to create a macro to select 2 worksheett and to save them as one pdf file and to name is based on the workbook name, the date and content in cell B3 on the dashboard. This is what I havw so far:

Sub PDFActiveSheet()
'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(), "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



Please can sanyone help?

 

[DanteAmor]

I am wanting to create a macro to select 2 worksheett and to save them as one pdf file

The following macro saves the sheets "Sheet1" and "Sheet2" as a single pdf file.

Set the names of "Sheet1" and "Sheet2" to the names of the sheets you want to save as a pdf on this line:​

Sheets(Array("Sheet1", "Sheet2")).Select

Also set the name of the sheet that contains the data that will be taken from cell B3 on this line:​

sName = sName & "_" & Format(Now(), "yyyymmdd_hhmm") & "_" & Sheets("Sheet1").Range("B3").Value & ".pdf"

Full code:​

Sub Export2pdf()
  Dim sPath As String, sName As String
  
  sPath = ThisWorkbook.Path & "\"
  sName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 'name is based on the workbook name
  sName = sName & "_" & Format(Now(), "yyyymmdd_hhmm") & "_" & Sheets("Sheet1").Range("B3").Value & ".pdf" 'the date and content in cell B3
  
  Sheets(Array("Sheet1", "Sheet2")).Select
  Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  
  MsgBox "PDF file has been created: " & vbCrLf & sPath & sName
End Sub

Note Code Tag:

In future please use code tags when posting code.​

How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.​

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[jdhfch]

The following macro saves the sheets "Sheet1" and "Sheet2" as a single pdf file.

Set the names of "Sheet1" and "Sheet2" to the names of the sheets you want to save as a pdf on this line:​

Sheets(Array("Sheet1", "Sheet2")).Select

Also set the name of the sheet that contains the data that will be taken from cell B3 on this line:​

sName = sName & "_" & Format(Now(), "yyyymmdd_hhmm") & "_" & Sheets("Sheet1").Range("B3").Value & ".pdf"

Full code:​

Sub Export2pdf()
  Dim sPath As String, sName As String
 
  sPath = ThisWorkbook.Path & "\"
  sName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 'name is based on the workbook name
  sName = sName & "_" & Format(Now(), "yyyymmdd_hhmm") & "_" & Sheets("Sheet1").Range("B3").Value & ".pdf" 'the date and content in cell B3
 
  Sheets(Array("Sheet1", "Sheet2")).Select
  Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
  MsgBox "PDF file has been created: " & vbCrLf & sPath & sName
End Sub

Note Code Tag:

In future please use code tags when posting code.​

How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.​

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

Thank you. This does create the worksheets aa a pdf, but both are blank?

 

[DanteAmor]

I'm sorry about that. It must be Activesheet.

Use the following:

Sub Export2pdf()
  Dim sPath As String, sName As String
  
  sPath = ThisWorkbook.Path & "\"
  sName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 'name is based on the workbook name
  sName = sName & "_" & Format(Now(), "yyyymmdd_hhmm") & "_" & Sheets("Sheet1").Range("B3").Value & ".pdf" 'the date and content in cell B3
  
  Sheets(Array("Sheet1", "Sheet2")).Select
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  
  MsgBox "PDF file has been created: " & vbCrLf & sPath & sName
End Sub

 

[jdhfch]

I'm sorry about that. It must be Activesheet.

Use the following:

Sub Export2pdf()
  Dim sPath As String, sName As String
 
  sPath = ThisWorkbook.Path & "\"
  sName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 'name is based on the workbook name
  sName = sName & "_" & Format(Now(), "yyyymmdd_hhmm") & "_" & Sheets("Sheet1").Range("B3").Value & ".pdf" 'the date and content in cell B3
 
  Sheets(Array("Sheet1", "Sheet2")).Select
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
  MsgBox "PDF file has been created: " & vbCrLf & sPath & sName
End Sub

Thank you. You are a star!

 

[Fluff]

In future please mark the post that contains the solution, rather than your post saying it works. Thanks