Hi, Kenneth
Thank you for your helpful suggestions. I've been tinkering with this project for a while now, and finally decided to "merge" my original code with code snippets gleaned from OzGrid and elsewhere. Your earlier post on checking for existing "same name" pdf's was certainly helpful in that regard! The pdf is created once the user completes a flight evaluation that takes about 5 minutes... and nobody wants to invest even that amount of time period something that won't save the evaluation results, so - among three different macros - my spreadsheet will generate pdf, or xps electronic copies when possible, a Word document if necessary, or - if all else fails - send the pertinent workbook pages to the printer. As of today, the code below accomplishes the electronic part of that chain, with a filename that lists the pilot's last name, the date of flight DD-MMM-YYY and type of evaluation ("Declared" or "Free", depending on the user-select analysis.) If a pdf or xps file by the exact same name is already on the desktop, the macro "proposes" a pdf file name the user must either use or change, as he sees fit... (By default, the pdf or xps file is headed for the desktop, and existing files are listed in the pertinent application's "save as" window, so the user can make an informed decision!) Once a valid filename is entered, Excel closes, and in the case of pdf or xps documents, it remains open for the user to review.
I have commented out the Excel workbook page names that will be used. For my test purposes, I've been testing this code in a smaller workbook with only 2 pages.
Option Explicit
Public Function GetDesktop() As String
GetDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
End Function
Sub ElecCopy()
Dim Msg, Style, Response
Dim DTAddress As String
Dim fn As String
Dim FName As Variant
ActiveWorkbook.Unprotect Password:="spike"
'Sheets("Verify Task").Visible = False
'Sheets("Calibration").Visible = False
'Sheets("Worksheet").Visible = True
On Error Resume Next
fn = GetDesktop & Range("E33").Text & ".pdf"
'ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Owner\Desktop\" & Range("E33").Text & ".pdf", OpenAfterPublish:=True
If Dir(fn) = "" Then
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, fn, OpenAfterPublish:=True
ElseIf Dir(fn) <> "" Then
DTAddress = GetDesktop
ChDir DTAddress
FName = Application.GetSaveAsFilename(FileFilter:="PDF files,*.pdf", Title:="Export to PDF")
If FName <> False Then
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End If
End If
If Err = 0 Then
Application.ScreenUpdating = False
'Sheets("Verify Task").Visible = True
'Sheets("Claim Check").Visible = False
'Sheets("Print This!").Visible = False
'Sheets("Worksheet").Visible = False
'ActiveWorkbook.Protect Password:="spike"
ActiveWorkbook.Saved = True
Application.Quit
ElseIf Err <> 0 Then
fn = GetDesktop & Range("E33").Text & ".xps"
If Dir(fn) = "" Then
ActiveWorkbook.ExportAsFixedFormat xlTypeXPS, fn, OpenAfterPublish:=True
ElseIf Dir(fn) <> "" Then
DTAddress = GetDesktop
ChDir DTAddress
FName = Application.GetSaveAsFilename(FileFilter:="XPS files,*.xps", Title:="Export to XPS")
If FName <> False Then
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypeXPS, Filename:=FName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End If
End If
If Err = 0 Then
Application.ScreenUpdating = False
'Sheets("Verify Task").Visible = True
'Sheets("Claim Check").Visible = False
'Sheets("Print This!").Visible = False
'Sheets("Worksheet").Visible = False
'ActiveWorkbook.Protect Password:="spike"
ActiveWorkbook.Saved = True
Application.Quit
ElseIf Err <> 0 Then
Msg = "ERROR! Neither a PDF nor an XPS document can be created." & vbNewLine & "Do you want to save results as a Word document?"
Style = vbYesNo + vbCritical + vbDefaultButton1
Response = MsgBox(Msg, Style)
If Response = vbYes Then
Application.Run "C.xlsm!SavDoc"
ElseIf Response = vbNo Then
Msg = "Click OK to exit then select 'Send to Printer' as the save method"
Style = vbOKOnly
Range("G16").Value = 1
End If
End If
End If
End Sub