Sub PrintSheetsToPDF2()
Dim sht As Worksheet
Dim fileSaveName As String, strDialogPrefix As String
strDialogPrefix = InputBox("Enter prefix", "Export")
For Each sht In ActiveWorkbook.Sheets
fileSaveName = strDialogPrefix & "-" & sht.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSaveName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "File Saved " & " " & fileSaveName
Next
End Sub
I didn't understand the second problem.
Sub PrintSheetsToPDF2()
Dim sht As Worksheet
Dim fileSaveName As String, strDialogPrefix As String
strDialogPrefix = InputBox("Enter prefix", "Export")
For Each sht In ActiveWorkbook.Sheets
fileSaveName = strDialogPrefix & "-" & sht.Name
sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSaveName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "File Saved " & " " & fileSaveName
Next
End Sub
Thanks Koen, missed that one.
Sub PrintSheetsToPDFFinal()
Dim sht As Worksheet
Dim fileSaveName As String, strDialogPrefix As String
strDialogPrefix = InputBox("Enter prefix", "Export")
For Each sht In ActiveWorkbook.Sheets
If sht.Visible = True Then
fileSaveName = strDialogPrefix & "-" & sht.Name
sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSaveName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "File Saved " & " " & fileSaveName
End If
Next
End Sub
Sub PrintSheetsToPDFFinal()
Dim sht As Worksheet
Dim fileSaveName As String, strDialogPrefix As String
strDialogPrefix = InputBox("Enter prefix", "Export")
For Each sht In ActiveWorkbook.Sheets
If sht.Visible = True Then
fileSaveName = BrowseForFolder & "\" & strDialogPrefix & "-" & sht.Name
sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSaveName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "File Saved " & " " & fileSaveName
End If
Next
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
'Source: http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Open in new window