A little code help on Excel Save to PDF

GiGi51

New Member
Joined
Nov 10, 2015
Messages
7
I'm new at coding. I have put together a code to save several worksheets to a pdf file and it is working except I can't figure out how to have it let me pick the filename and path. As it is it just overwrites the previously saved file.
TIA


Public Sub SaveSheetsAsPDF()
Dim wksAllSheets As Variant
Dim wksSheet1 As Worksheet
Dim strFilename As String, strFilepath As String
Dim dlgFolder As FileDialog


'Set references
Set wksSheet1 = ThisWorkbook.Sheets("TimeEnter")
wksAllSheets = Array("TimePrint", "ExpPrint", "MilesPrint")


'Set path
Set dlgFolder = Application.FileDialog(msoFileDialogFolderPicker)
With dlgFolder
.Title = "Select Target Folder Containing Mandate Files"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
strFilepath = .SelectedItems(1) & ""
End With


'Create the full Filename using indicated cells
With wksSheet1
strFilename = strFilepath & .Range("A3").Value & " " & .Range("B3").Value & ".pdf"
End With


' Make the sheets visible
ThisWorkbook.Sheets("TimePrint").Visible = xlSheetVisible
ThisWorkbook.Sheets("ExpPrint").Visible = xlSheetVisible
ThisWorkbook.Sheets("MilesPrint").Visible = xlSheetVisible
' Select the sheets
ThisWorkbook.Sheets(wksAllSheets).Select
'Save the array of worksheets as a PDF
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PdfFilename, _
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
End Sub
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,390
Incorporate this part (from bakerman2) into your code.
Code:
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
Application.ScreenUpdating = False
Filepath = .SelectedItems(1)
fName = Application.InputBox("Enter name for PDF-file.", , , , , , , 2)
'It sets format as PDF
ActiveSheet.ExportAsFixedFormat 0, Filepath & "\" & fName, , , , , , True
Application.ScreenUpdating = True
 
Last edited:

GiGi51

New Member
Joined
Nov 10, 2015
Messages
7
Incorporate this part (from bakerman2) into your code.
Code:
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
Application.ScreenUpdating = False
Filepath = .SelectedItems(1)
fName = Application.InputBox("Enter name for PDF-file.", , , , , , , 2)
'It sets format as PDF
ActiveSheet.ExportAsFixedFormat 0, Filepath & "\" & fName, , , , , , True
Application.ScreenUpdating = True

Could you show me where to put this in the code? Thanks
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,390
Could you put your code between code brackets first please.
[ code] (without the space) at the beginning of the code and [/ code] (without space again) at the end of the code.
 

GiGi51

New Member
Joined
Nov 10, 2015
Messages
7
Rich (BB code):
Public Sub SaveSheetsAsPDF()
Dim wksAllSheets As Variant
Dim wksSheet1 As Worksheet
Dim strFilename As String, strFilepath As String
Dim dlgFolder As FileDialog


'Set references
Set wksSheet1 = ThisWorkbook.Sheets("TimeEnter")
wksAllSheets = Array("TimePrint", "ExpPrint", "MilesPrint")


'Set path
Set dlgFolder = Application.FileDialog(msoFileDialogFolderPicker)
With dlgFolder
.Title = "Select Target Folder Containing Mandate Files"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
strFilepath = .SelectedItems(1) & ""
End With


'Create the full Filename using indicated cells
With wksSheet1
strFilename = strFilepath & .Range("A3").Value & " " & .Range("B3").Value & ".pdf"
End With


' Make the sheets visible
ThisWorkbook.Sheets("TimePrint").Visible = xlSheetVisible
ThisWorkbook.Sheets("ExpPrint").Visible = xlSheetVisible
ThisWorkbook.Sheets("MilesPrint").Visible = xlSheetVisible
' Select the sheets
ThisWorkbook.Sheets(wksAllSheets).Select
'Save the array of worksheets as a PDF
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PdfFilename, _
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
End Sub
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,390
Sorry GiGi51.
What I meant is to go back to your first Post and change it in that one. There is a way of doing that but unfortunately, I don't know how.
Lets hope that somebody that knows how will fly by and let us know.

Does this get you anywhere?

Code:
Sub Maybe()
Dim Filepath As String, fName As String, a As String
Dim ws1 As Worksheet, wsAll, i As Long

Application.ScreenUpdating = False
Set ws1 = ThisWorkbook.Worksheets("TimeEnter")
a = ActiveSheet.Name
wsAll = Array("TimePrint", "ExpPrint", "MilesPrint")

For i = LBound(wsAll) To UBound(wsAll)
    Sheets(wsAll(i)).Visible = True
Next i

    'If you need to do more, do it here

Sheets(wsAll).Select

With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show Then
        Filepath = .SelectedItems(1)

        fName = Application.InputBox("Enter name for PDF-file.", , , , , , , 2)

        ActiveSheet.ExportAsFixedFormat 0, Filepath & "\" & fName, , , , , , True
            Else
        Exit Sub

    End If
End With
Worksheets(wsAll).Visible = False
Worksheets(a).Select
Application.ScreenUpdating = True
End Sub
BTW, don't quote whole posts. You can always refer to a Post number. That'll minimize the clutter.

I just noticed that you also want to clear the three sheets.
Insert your code after the "End With" just about at the end of the code.
 
Last edited:

Forum statistics

Threads
1,078,437
Messages
5,340,277
Members
399,361
Latest member
Linford

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top