UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Vba To Save As Pdf - Office 2016, Any Version    
 
   
ginmarie
post Nov 7 2019, 06:19 PM
Post#1



Posts: 176
Joined: 28-August 10



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.
This post has been edited by ginmarie: Nov 7 2019, 06:20 PM
Attached File(s)
Attached File  My_TimeSheet.zip ( 152.2K )Number of downloads: 7
 
Go to the top of the page
 
strive4peace
post Nov 9 2019, 11:15 PM
Post#2


strive4peace
Posts: 20,464
Joined: 10-January 04



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.




--------------------
have an awesome day,
crystal
Go to the top of the page
 
ginmarie
post Nov 15 2019, 01:25 PM
Post#3



Posts: 176
Joined: 28-August 10



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]



Go to the top of the page
 
cheekybuddha
post Nov 15 2019, 02:48 PM
Post#4


UtterAccess Moderator
Posts: 11,896
Joined: 6-December 03
From: Telegraph Hill


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

--------------------


Regards,

David Marten
Go to the top of the page
 
strive4peace
post Nov 15 2019, 03:23 PM
Post#5


strive4peace
Posts: 20,464
Joined: 10-January 04



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


--------------------
have an awesome day,
crystal
Go to the top of the page
 
ginmarie
post Nov 15 2019, 05:33 PM
Post#6



Posts: 176
Joined: 28-August 10



Wahoo!!! It works beautifully! Thank you so very much!
Go to the top of the page
 
strive4peace
post Nov 16 2019, 03:21 PM
Post#7


strive4peace
Posts: 20,464
Joined: 10-January 04



you're welcome, Marie ~ happy to help


--------------------
have an awesome day,
crystal
Go to the top of the page
 
cheekybuddha
post Nov 16 2019, 04:54 PM
Post#8


UtterAccess Moderator
Posts: 11,896
Joined: 6-December 03
From: Telegraph Hill


thumbup.gif

--------------------


Regards,

David Marten
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    10th December 2019 - 10:35 AM