Printable Version of Topic

Click here to view this topic in its original format

UtterAccess Forums _ Microsoft Excel _ Vba To Save As Pdf - Office 2016

Posted by: ginmarie Nov 7 2019, 06:19 PM

I have written some vba within a workbook that unhides specific sheets and saves them as a single pdf. Everything works great, but I need to be able to Save as, and choose where to store the file and what to name it vs, having it go to a default folder and not be able to be named differently each time.
I found some code that should allow this using the Application.GetSaveAsFilename method, but I am so new at all of this, I am not sure how to integrate it into my existing code.

 My_TimeSheet.zip ( 152.2K ): 9
 

Posted by: strive4peace Nov 9 2019, 11:15 PM

here is the syntax

this is the code I modified or added:

CODE
   Dim strFilter As String   '---------------------- added
   Dim strTitle As String    '---------------------- added

   'Set path
   strFilepath = "c:\temp\" 'start directory -- change as desired
   'Create the starting path and Filename using indicated cells
   With wksSheet1
      strFileName = .Range("A3").Value & " " & .Range("B3").Value & ".pdf"
      strFileName = strFilepath & strFileName '---------------------- modified
   End With
  
   'prompt user so the folder or name can be changed
   strFilter = "PDF Files, *.pdf"
   strTitle = "Target Folder and File for Mandate"
   strPathFile = Application.GetSaveAsFilename(strPathFile, strFilter, , strTitle)    

    ' Make the sheets visible
    ThisWorkbook.Sheets("TimePrint").Visible = xlSheetVisible '---------------------- added
    ThisWorkbook.Sheets("ExpPrint").Visible = xlSheetVisible '---------------------- added
    ThisWorkbook.Sheets("MilesPrint").Visible = xlSheetVisible '---------------------- added

Before you can hide sheets again, if there is any issue, you may need to sleep a little bit so the report can finish processing.




Posted by: ginmarie Nov 15 2019, 01:25 PM

Thank you so much. I just got back to being able to work on this. Your code got me a bit further but I'm getting an error message "file not saved..."
and when I open the debugger, this part is highlighted:

'Save the array of worksheets as a PDF
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True[/color]




Posted by: cheekybuddha Nov 15 2019, 02:48 PM

Looks like you should use strPathFile instead of strFileName:

CODE
'Save the array of worksheets as a PDF
ActiveSheet.ExportAsFixedFormat _
  Type:=xlTypePDF, _
  filename:=strPathFile, _
  Quality:=xlQualityStandard, _
  IncludeDocProperties:=True, _
  IgnorePrintAreas:=False, _
  OpenAfterPublish:=True

Posted by: strive4peace Nov 15 2019, 03:23 PM

thanks for noticing that, David!
ginmarie, I just tested this code and it works:

CODE
Public Sub SaveSheetsAsPDF()
'modified 191115
   On Error GoTo Proc_Err

   Dim wksAllSheets As Variant
   Dim wksSheet1 As Worksheet
   Dim strFileName As String, strFilepath As String
  
   Dim strPathFile As String '---------------------- added
   Dim strFilter As String   '---------------------- added
   Dim strTitle As String    '---------------------- added
  
   'Set references
   Set wksSheet1 = ThisWorkbook.Sheets("TimePrint")
   wksAllSheets = Array("TimePrint", "ExpPrint", "MilesPrint")
  
   'Set path
   strFilepath = "c:\temp\" '----------------- MODIFY
   'Create the starting path and Filename using indicated cells
   With wksSheet1
      strFileName = Trim(.Range("A3").Value & " " & .Range("B3").Value) & ".pdf"
      strPathFile = strFilepath & strFileName '---------------------- changed
   End With
  
   'prompt user so the folder or name can be changed
   strFilter = "PDF Files, *.pdf"
   strTitle = "Target Folder and File for Mandate"
   strPathFile = Application.GetSaveAsFilename(strPathFile, strFilter, , strTitle)
   'quit if user picked Cancel

   If Not strPathFile <> "False" Then
      Debug.Print "Cancelled SaveSheetsAsPDF, " & Now
      GoTo Proc_Exit
   End If
    
    ' Make the sheets visible
    ThisWorkbook.Sheets("TimePrint").Visible = xlSheetVisible '---------------------- added
    ThisWorkbook.Sheets("ExpPrint").Visible = xlSheetVisible '---------------------- added
    ThisWorkbook.Sheets("MilesPrint").Visible = xlSheetVisible '---------------------- added
    ThisWorkbook.Sheets("TimeEnter").Visible = xlSheetVisible
    ThisWorkbook.Sheets("ExpEnter").Visible = xlSheetVisible
    ThisWorkbook.Sheets("MilesEnter").Visible = xlSheetVisible
    ' Select the sheets
    ThisWorkbook.Sheets(wksAllSheets).Select
    
    'Save the array of worksheets as a PDF '---------------------- changed: strPathFile
   ActiveSheet.ExportAsFixedFormat _
         Type:=xlTypePDF _
         , filename:=strPathFile _
         , Quality:=xlQualityStandard _
         , IncludeDocProperties:=True _
         , IgnorePrintAreas:=False _
         , OpenAfterPublish:=True
              
    Worksheets("MilesEnter").Range("ClearMiles").ClearContents
    Worksheets("TimeEnter").Range("ClearTime").ClearContents
    Worksheets("ExpEnter").Range("ClearExp").ClearContents

    'Deselect all the exported worksheets
    ' Hide the exported sheets
    ThisWorkbook.Sheets(wksAllSheets).Visible = xlSheetHidden
    
    Debug.Print "Done creating " & strPathFile & ", " & Now
    
Proc_Exit:
   On Error Resume Next
   Exit Sub
  
Proc_Err:
   MsgBox Err.Description _
       , , "ERROR " & Err.Number _
        & "   SaveSheetsAsPDF"

   Resume Proc_Exit
   Resume
End Sub


Posted by: ginmarie Nov 15 2019, 05:33 PM

Wahoo!!! It works beautifully! Thank you so very much!

Posted by: strive4peace Nov 16 2019, 03:21 PM

you're welcome, Marie ~ happy to help


Posted by: cheekybuddha Nov 16 2019, 04:54 PM

thumbup.gif