Option Explicit
Function Path_Exists(Path As String) As String
'Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult
' Path = "C:\Users\allso\Desktop\excel_to_pdf"
Folder = dir(Path, vbDirectory)
' MsgBox (Path)
' MsgBox (Folder)
If Folder = vbNullString Then
Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")
Select Case Answer
Case vbYes
VBA.FileSystem.MkDir (Path)
Case Else
Exit Function
End Select
Else
' MsgBox "Folder exists."
End If
Path_Exists = Path
End Function
Sub vba_excel_to_pdf()
'Path_Exists ("C:\Users\allso\Desktop\excel_to_pdf")
Dim output_file As String, ws_count, I As Integer
'output_file = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".pdf"
'MsgBox (output_file)
'Set the location where the pdfs will be saved
'Dim pdffolder As FileDialog
'
'
'
'
'Set pdffolder = Application.FileDialog(msoFileDialogFolderPicker)
'pdffolder.AllowMultiSelect = False
'pdffolder.Show
'
'
Dim dir As String
'dir = pdffolder.SelectedItems(1)
dir = Path_Exists("C:\Users\allso\Desktop\excel_to_pdf")
'MsgBox (dir)
Dim strtime As String
' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dir & "\" & customer_code & ".pdf", openafterpublish:=False
' Set WS_Count equal to the number of worksheets in the active
ws_count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To ws_count
' Insert your code here.
' The following line shows how to reference a sheet within
' the loop by displaying the worksheet name in a dialog box.
' MsgBox ActiveWorkbook.Worksheets(I).Name
strtime = Format(Now(), "yyyymmdd\_hhmmss")
' MsgBox (strtime)
output_file = dir & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "." & ActiveWorkbook.Worksheets(I).Name & "." & strtime & ".pdf"
'MsgBox (output_file)
ActiveWorkbook.Worksheets(I).ExportAsFixedFormat xlTypePDF, output_file, xlQualityStandard, openafterpublish:=False
'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=output_file, openafterpublish:=False
Next I
End Sub
Source:https://www.contextures.com/excelvbapdf.html
No comments:
Post a Comment