Save specific sheet as PDF

JoshLyman

JoshLyman

New Member
Joined
Jan 11, 2023
Messages
35
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
I'm currently using the below code to allow users to save the active sheet as PDF, as well as renaming it according to the sheet name/date/time. I have it assigned to a button at the end of each individual sheet and it works great. However, I have a main 'Dashboard' sheet that lists all of the other sheets (e.g., Sheet1, Sheet2, Sheet3) and I would like to have a button for each of them on the dashboard that allows the user to save that specific sheet as a PDF in exactly the same way as below. Initially I thought about it just being 1 button which then prompted the user to specify which sheet they wanted to save as PDF, but that's way beyond my capabilities and I am assuming much more difficult.. so a button for each sheet which allows them to click and save it as PDF would work just fine.

VBA Code: 
Sub PDFActiveSheet()
'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

Any and all help would be greatly appreciated.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
JoshLyman said:
I'm currently using the below code to allow users to save the active sheet as PDF, as well as renaming it according to the sheet name/date/time. I have it assigned to a button at the end of each individual sheet and it works great. However, I have a main 'Dashboard' sheet that lists all of the other sheets (e.g., Sheet1, Sheet2, Sheet3) and I would like to have a button for each of them on the dashboard that allows the user to save that specific sheet as a PDF in exactly the same way as below. Initially I thought about it just being 1 button which then prompted the user to specify which sheet they wanted to save as PDF, but that's way beyond my capabilities and I am assuming much more difficult.. so a button for each sheet which allows them to click and save it as PDF would work just fine.

VBA Code: 
Sub PDFActiveSheet()
'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

Any and all help would be greatly appreciated.
Click to expand...

I've used this idea before now.

It gives you a list of sheets to enter a number and then calls your routine.

VBA Code: 
Public Sub subListOfWorksheets()
Dim Ws As Worksheet
Dim strMsg As String
Dim varOption As Variant

    ActiveWorkbook.Save

On Error GoTo Err_Handler

    For Each Ws In ActiveWorkbook.Worksheets
        strMsg = strMsg & Ws.Index & " : " & Ws.Name & vbCrLf
    Next Ws
    
    strMsg = strMsg & "Enter a value between 1 and " & Sheets.Count
        
    varOption = InputBox(strMsg, "Select Worksheet Number")
    
    If varOption = "" Then
        Exit Sub
    End If
    
    Worksheets(Val(varOption)).Activate
    
    strMsg = "Create PDF from this sheet?"
    
    If MsgBox(strMsg, vbYesNo, "Confirmation") = vbYes Then
        Call PDFActiveSheet
    End If
    
Exit_Handler:

    Exit Sub

Err_Handler:

    Resume Exit_Handler
    
End Sub
 
Upvote 1
Thanks for the reply Herakles! I've tried adding that as a separate sub in ThisWorkbook and have assigned it to a button on the Dashboard, however at the very end (after choosing the sheet and saying 'yes' to 'create pdf') I am getting

1692088050953.png


Should I be arranging them differently from the below?

VBA Code: 
Sub PDFActiveSheet()
'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

Public Sub subListOfWorksheets()
Dim Ws As Worksheet
Dim strMsg As String
Dim varOption As Variant

    ActiveWorkbook.Save

On Error GoTo Err_Handler

    For Each Ws In ActiveWorkbook.Worksheets
        strMsg = strMsg & Ws.Index & " : " & Ws.Name & vbCrLf
    Next Ws
   
    strMsg = strMsg & "Enter a value between 1 and " & Sheets.Count
       
    varOption = InputBox(strMsg, "Select Worksheet Number")
   
    If varOption = "" Then
        Exit Sub
    End If
   
    Worksheets(Val(varOption)).Activate
   
    strMsg = "Create PDF from this sheet?"
   
    If MsgBox(strMsg, vbYesNo, "Confirmation") = vbYes Then
        Call PDFActiveSheet
    End If
   
Exit_Handler:
    Exit Sub

Err_Handler:
    Resume Exit_Handler
   
End Sub
 
Upvote 0
JoshLyman said:
Thanks for the reply Herakles! I've tried adding that as a separate sub in ThisWorkbook and have assigned it to a button on the Dashboard, however at the very end (after choosing the sheet and saying 'yes' to 'create pdf') I am getting

View attachment 97183

Should I be arranging them differently from the below?

VBA Code: 
Sub PDFActiveSheet()
'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

Public Sub subListOfWorksheets()
Dim Ws As Worksheet
Dim strMsg As String
Dim varOption As Variant

    ActiveWorkbook.Save

On Error GoTo Err_Handler

    For Each Ws In ActiveWorkbook.Worksheets
        strMsg = strMsg & Ws.Index & " : " & Ws.Name & vbCrLf
    Next Ws
  
    strMsg = strMsg & "Enter a value between 1 and " & Sheets.Count
      
    varOption = InputBox(strMsg, "Select Worksheet Number")
  
    If varOption = "" Then
        Exit Sub
    End If
  
    Worksheets(Val(varOption)).Activate
  
    strMsg = "Create PDF from this sheet?"
  
    If MsgBox(strMsg, vbYesNo, "Confirmation") = vbYes Then
        Call PDFActiveSheet
    End If
  
Exit_Handler:
    Exit Sub

Err_Handler:
    Resume Exit_Handler
  
End Sub
Click to expand...
Comment out this line to see where the error is in your code.

On Error GoTo errHandler
 
Upvote 0
Commented it out of the sublistofworksheets sub and it gave me

1692091362907.png

Doesn't highlight any of the code specifically
 
Upvote 0
Sorry mate, I'm only vaguely aware of what that means. Am noob 🥲
 
Upvote 0
JoshLyman said:
Sorry mate, I'm only vaguely aware of what that means. Am noob 🥲
Click to expand...
To set a breakpoint

  1. Place the insertion point on the first line of code in your procedure.
  2. On the Debug menu, choose Toggle Breakpoint .
    The breakpoint is added
Run the procedure.
 
Upvote 0
Ok so I think the issue is because the subsheets are all veryhidden (by design). When I've unhidden one of them, run the script, and chosen that sheet, it works perfectly fine. It's when I try to choose a sheet that is still veryhidden that it breaks. Is there a way for the script to unhide the chosen sheet, save it as PDF, then re-(very)hide it afterwards?
 
Upvote 0
JoshLyman said:
Ok so I think the issue is because the subsheets are all veryhidden (by design). When I've unhidden one of them, run the script, and chosen that sheet, it works perfectly fine. It's when I try to choose a sheet that is still veryhidden that it breaks. Is there a way for the script to unhide the chosen sheet, save it as PDF, then re-(very)hide it afterwards?
Click to expand...
Replace my code with this.

It unhides the sheet and then hides it if necessary.

VBA Code: 
Public Sub subListOfWorksheets()
Dim Ws As Worksheet
Dim strMsg As String
Dim varOption As Variant
Dim intVisible As Integer

    ActiveWorkbook.Save
            
On Error GoTo Err_Handler

    For Each Ws In ActiveWorkbook.Worksheets
        strMsg = strMsg & Ws.Index & " : " & Ws.Name & vbCrLf
    Next Ws
    
    strMsg = strMsg & "Enter a value between 1 and " & Sheets.Count
        
    varOption = InputBox(strMsg, "Select Worksheet Number")
    
    If varOption = "" Then
        Exit Sub
    End If
    
    Set Ws = Worksheets(Val(varOption))
    
    intVisible = Ws.Visible
    
    Ws.Visible = True
    
    Ws.Activate
        
    If MsgBox("Create PDF from this sheet?", vbYesNo, "Confirmation") = vbYes Then
            Call PDFActiveSheet
    End If
    
    Ws.Visible = intVisible
    
Exit_Handler:

    Exit Sub

Err_Handler:

    Resume Exit_Handler
    
End Sub
 
Upvote 1
Solution
You must log in or register to reply here.

Similar threads

K
  • Question Question
Open Hyperlink Once saved
Replies
2
Views
450
fourdragons
F
J
  • Solved
VBA Code to create pdf and name it based on criteria
Replies
5
Views
1K
Fluff
Fluff
tlc53
  • Question Question
VBA Save All Relevant Report into One Document
Replies
5
Views
667
tlc53
tlc53
R
  • Solved
VBA to Save As PDF Tweak
2
Replies
13
Views
2K
rodl66
R
youbitto
  • Solved
Searching For a value in a range and write a texte if the value is found
Replies
2
Views
80
youbitto
youbitto

Forum statistics

Threads
1,224,813
Messages
6,181,112
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top