Getting Userform Command Buttons to Work with a BeforeSave VBA Macro

[letswriteafairytale]

I have created a userform with 3 buttons, "Save as .XLSM", "Save as .PDF" and "Cancel"

What I would like is for this command box to pop up when we go to save the document (click on save as > browse)

The buttons work just fine every time someone hits Save as .PDF.

BUT, it will only work once if someone chooses save as .XLSM, it will save as .xlsm, then when you go to save again, the save as dialog box opens, but doesn't actually ever save again.

Here is the BeforeSave VBA:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel as Boolean)
    Cancel = True
    UserForm1.Show
End Sub

Here is the UserForm1 code:

Private Sub CommandButton1_Click()
Call Save_as_XLSM
End Sub

Private Sub CommandButton2_Click()
Call Save_as_PDF
End Sub

Private Sub CommandButton3_Click()
Call Cancel
End Sub

Private Sub Label1_Click()

End Sub

Private Sub Save_as_XLSM()
 Dim ws As Sheet1
    Dim filename As String
    Dim saveAsDialog
    Dim savePath As Variant

    Set ws = ThisWorkbook.ActiveSheet

saveAsDialog = Application.GetSaveAsFilename( _
    filefilter:="Macro-Enabled Workbook (*.xlsm), *xlsm", InitialFileName:="", Title:="Please choose location to save this document")
    
  If saveAsDialog <> False Then
        ActiveWorkbook.SaveAs filename:=saveAsDialog, FileFormat:=52
        Exit Sub
    End If
Unload Me
End Sub


Private Sub Save_as_PDF()
Dim ws As Sheet1
    Dim filename As String
    Dim saveAsDialog
    Dim savePath As Variant
 
 Set ws = ThisWorkbook.ActiveSheet

saveAsDialog = Application.GetSaveAsFilename( _
    filefilter:="PDF Files (*.pdf), *pdf", InitialFileName:="", Title:="Please choose location to save this document")

  If saveAsDialog <> False Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=saveAsDialog, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        Exit Sub
    End If
Unload Me
End Sub

Private Sub Cancel()
Unload Me
    End
End Sub

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Click()

End Sub

 

[Logit]

I would totally remove that macro from the ThisWorkbook module. It isn't promoting your project at all.

Here is a sample macro for saving as PDF. Let me know if it works for you.

Sub SaveWorkbookAsPDF()
    Dim filePath As String
    ' Open Save As dialog box with PDF filter
    filePath = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Save as PDF")
    
    ' Check if user selected a file path
    If filePath <> "False" Then
        ' Save the workbook as PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath
    End If
End Sub

 

[letswriteafairytale]

I would totally remove that macro from the ThisWorkbook module. It isn't promoting your project at all.

Here is a sample macro for saving as PDF. Let me know if it works for you.

Sub SaveWorkbookAsPDF()
    Dim filePath As String
    ' Open Save As dialog box with PDF filter
    filePath = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Save as PDF")
  
    ' Check if user selected a file path
    If filePath <> "False" Then
        ' Save the workbook as PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath
    End If
End Sub

That works for PDF. But, I want both options of XLSM AND PDF, ONLY.

We make the Excel spreadsheet template, XLTM, because I have a module for something there. When we open it, edit it, and save it, not everyone will remember to save it as xlsm. So, I don't want any other excel option for them. Once the spreadsheet has been reviewed and finalized by the boss, we then save as PDF. I feel like it SHOULDN'T be as complicated as it has been for me to accomplish this, but proving to be a bit of a hassle.

I tried this code before, but PDF doesn't work because PDF needs to be exported, not save as:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    If Right(ThisWorkbook.Name, 4) <> "xlsm" Then
        Dim txtFileName As String, opt As Variant
        opt = MsgBox("If you have made changes to this workbook must be saved as a macro enabled workbook." & vbLf & _
        "If you have made no changes and want to exit without saving, click the 'YES' button", vbYesNo + vbExclamation, "EXIT OPTION")
            If opt = vbYes Then
                Cancel = False
                Exit Sub
            End If
        Cancel = True
        txtFileName = Application.GetSaveAsFilename(InitialFileName:=strWorkBookName, _
                                            FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, PDF File (*.pdf),*.pdf", _
                                            Title:="Save As XLSM or PDF file")
        If txtFileName = "False" Then
            MsgBox "Action Cancelled", vbOKOnly
            Cancel = True
            Exit Sub
        End If
        Application.EnableEvents = False
            ThisWorkbook.SaveAs Filename:=txtFileName, FileFormat:=52 'xlOpenXMLWorkbookMacroEnabled
        Application.EnableEvents = True
    End If
End Sub

 

[Logit]

Why are you using the BeforeSaveAs module in the ThisWorkBook module ?

Isn't having the save for .XLSM and .PDF sufficient in the UserForm ?

 

[letswriteafairytale]

Why are you using the BeforeSaveAs module in the ThisWorkBook module ?

Isn't having the save for .XLSM and .PDF sufficient in the UserForm ?

Because I need the UserForm to pop up when saving the file, so they can pick XLSM or PDF. Is there another way the UserForm be called when saving the file?


Thanks!

 

[Logit]

Since you are using Excel 365 try this macro instead :

Sub SaveWorkbookAsPDF()
    Dim PDFPath As String
    Dim PDFName As String
    Dim FileDialog As FileDialog
    
    ' Prompt user to select a location and enter a file name
    On Error Resume Next
    Set FileDialog = Application.FileDialog(msoFileDialogSaveAs)
    On Error GoTo 0
    
    If Not FileDialog Is Nothing Then
        With FileDialog
            .Title = "Save As PDF"
            .FilterIndex = 2
            .InitialFileName = Application.ActiveWorkbook.Name & ".pdf"
            If .Show = -1 Then
                PDFPath = .SelectedItems(1)
            Else
                MsgBox "No file name was selected. Operation cancelled.", vbExclamation
                Exit Sub
            End If
        End With
    Else
        MsgBox "File dialog could not be opened. Operation cancelled.", vbCritical
        Exit Sub
    End If

    ' Save the active workbook as a PDF
    On Error GoTo ErrorHandler
    Application.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    MsgBox "Workbook successfully saved as PDF.", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while saving the PDF. Please try again.", vbCritical
End Sub

 

[Logit]

Ref the form .... but again I ask why are you using the Before Save function ? Just use the code located in the user form as is. Nothing else is required unless I
completely misunderstand your goal.

 

[letswriteafairytale]

Ref the form .... but again I ask why are you using the Before Save function ? Just use the code located in the user form as is. Nothing else is required unless I
completely misunderstand your goal.

The before save function is the only way I have found to call the UserForm OR Save As Dialog box when saving the file. How would I use the user form code as is to work when saving the document?

I'm still very new at this, I've done a lot of research, and understand a few basics, but still unclear on quite a bit of this.

The code you just sent is still only save/export as 1 file type, PDF. I want XLSM & PDF to the be only options to choose from when saving the file (or XLTM since I need to make the templates first).

Basically like this when saving the file.

OR Have my UserForm work as intended when going to save the file. When clicking save as PDF, let the person choose the file location and name it, PDF is the only option and it will export as PDF. Or choose save as XLSM, let the person choose the file location and name it, XLSM is the only option.

Does that make sense?

 

[Logit]

This Macro and Functions successfully save the workbook as a PDF file.

Sub Save_as_PDF()
    Dim PDFPath As String
    Dim FileDialog As FileDialog
    Dim ws As Worksheet
    Dim TempWorkbook As Workbook
    Dim TempSheet As Worksheet
    Dim hasData As Boolean
    Dim sheetName As String
    Dim uniqueName As String
    Dim i As Integer

    ' Set up FileDialog for saving as PDF
    On Error Resume Next
    Set FileDialog = Application.FileDialog(msoFileDialogSaveAs)
    On Error GoTo 0

    If Not FileDialog Is Nothing Then
        With FileDialog
            .Title = "Save As PDF"
            .InitialFileName = Application.ActiveWorkbook.Name & ".pdf"
            If .Show = -1 Then
                PDFPath = .SelectedItems(1)

                ' Ensure the selected file path has a .pdf extension
                If Right(PDFPath, 4) <> ".pdf" Then
                    PDFPath = PDFPath & ".pdf"
                End If
            Else
                MsgBox "No file name was selected. Operation cancelled.", vbExclamation
                Exit Sub
            End If
        End With
    Else
        MsgBox "File dialog could not be opened. Operation cancelled.", vbCritical
        Exit Sub
    End If

    ' Check if "Sheet1" exists
    On Error Resume Next
    Set ws = Application.ActiveWorkbook.Sheets("Sheet1")
    On Error GoTo 0

    If ws Is Nothing Then
        MsgBox "Sheet1 does not exist in the active workbook.", vbExclamation
        Exit Sub
    End If

    ' Create a temporary workbook to store Sheet1
    Set TempWorkbook = Application.Workbooks.Add

    ' Disable alerts temporarily
    Application.DisplayAlerts = False
    TempWorkbook.Sheets(1).Delete ' Delete the default sheet
    Application.DisplayAlerts = True ' Re-enable alerts

    ' Copy Sheet1 to the temporary workbook
    If WorksheetHasData(ws) Then
        sheetName = ws.Name
        uniqueName = sheetName
        i = 1

        ' Ensure the sheet name is unique in the temporary workbook
        Do While SheetExists(uniqueName, TempWorkbook)
            uniqueName = sheetName & "_" & i
            i = i + 1
        Loop

        Set TempSheet = TempWorkbook.Sheets.Add(After:=TempWorkbook.Sheets(TempWorkbook.Sheets.Count))
        TempSheet.Name = uniqueName
        ws.UsedRange.Copy
        TempSheet.Range("A1").PasteSpecial xlPasteAll

        ' Set print area for the copied sheet
        TempSheet.PageSetup.PrintArea = TempSheet.UsedRange.Address

        hasData = True
    End If

    ' Check if the temporary workbook has any data
    If Not hasData Then
        MsgBox "Sheet1 has no data to save as PDF.", vbExclamation
        TempWorkbook.Close SaveChanges:=False
        Exit Sub
    End If

    ' Adjust page setup for the sheet in the temporary workbook
    For Each TempSheet In TempWorkbook.Worksheets
        With TempSheet.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    Next TempSheet

    Application.DisplayAlerts = False

    ' Save the temporary workbook as PDF
    TempWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
        fileName:=PDFPath, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    ' Close the temporary workbook without saving
    TempWorkbook.Close SaveChanges:=False

    MsgBox "Sheet1 successfully saved as PDF.", vbInformation
End Sub

' Function to check if the worksheet has any visible data
Private Function WorksheetHasData(ws As Worksheet) As Boolean
    ' Check if UsedRange contains any visible data
    On Error Resume Next
    Dim cell As Range
    Dim isData As Boolean
    isData = False
    
    ' Loop through cells in UsedRange to check for any visible data
    For Each cell In ws.UsedRange
        If Not IsEmpty(cell.Value) Then
            isData = True
            Exit For
        End If
    Next cell
    On Error GoTo 0

    WorksheetHasData = isData
End Function

Private Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Sheets(sheetName)
    SheetExists = Not ws Is Nothing
    On Error GoTo 0
End Function

I had to delete any worksheets in your workbook that are blank. There was only one. A blank worksheet for some reason was creating error messages when
the macro was run.

This macro for some reason thinks the PDF file already exists in the selected folder if the file had been saved there previously using the same name. This can be overcome
by saving to a different folder or changing the name of the saved file, Someone else may be able to overcome this shortcoming. I apologize I couldn't correct this.

Download edited workbook : Internxt Drive – Private & Secure Cloud Storage

 

[letswriteafairytale]

This Macro and Functions successfully save the workbook as a PDF file.

Sub Save_as_PDF()
    Dim PDFPath As String
    Dim FileDialog As FileDialog
    Dim ws As Worksheet
    Dim TempWorkbook As Workbook
    Dim TempSheet As Worksheet
    Dim hasData As Boolean
    Dim sheetName As String
    Dim uniqueName As String
    Dim i As Integer

    ' Set up FileDialog for saving as PDF
    On Error Resume Next
    Set FileDialog = Application.FileDialog(msoFileDialogSaveAs)
    On Error GoTo 0

    If Not FileDialog Is Nothing Then
        With FileDialog
            .Title = "Save As PDF"
            .InitialFileName = Application.ActiveWorkbook.Name & ".pdf"
            If .Show = -1 Then
                PDFPath = .SelectedItems(1)

                ' Ensure the selected file path has a .pdf extension
                If Right(PDFPath, 4) <> ".pdf" Then
                    PDFPath = PDFPath & ".pdf"
                End If
            Else
                MsgBox "No file name was selected. Operation cancelled.", vbExclamation
                Exit Sub
            End If
        End With
    Else
        MsgBox "File dialog could not be opened. Operation cancelled.", vbCritical
        Exit Sub
    End If

    ' Check if "Sheet1" exists
    On Error Resume Next
    Set ws = Application.ActiveWorkbook.Sheets("Sheet1")
    On Error GoTo 0

    If ws Is Nothing Then
        MsgBox "Sheet1 does not exist in the active workbook.", vbExclamation
        Exit Sub
    End If

    ' Create a temporary workbook to store Sheet1
    Set TempWorkbook = Application.Workbooks.Add

    ' Disable alerts temporarily
    Application.DisplayAlerts = False
    TempWorkbook.Sheets(1).Delete ' Delete the default sheet
    Application.DisplayAlerts = True ' Re-enable alerts

    ' Copy Sheet1 to the temporary workbook
    If WorksheetHasData(ws) Then
        sheetName = ws.Name
        uniqueName = sheetName
        i = 1

        ' Ensure the sheet name is unique in the temporary workbook
        Do While SheetExists(uniqueName, TempWorkbook)
            uniqueName = sheetName & "_" & i
            i = i + 1
        Loop

        Set TempSheet = TempWorkbook.Sheets.Add(After:=TempWorkbook.Sheets(TempWorkbook.Sheets.Count))
        TempSheet.Name = uniqueName
        ws.UsedRange.Copy
        TempSheet.Range("A1").PasteSpecial xlPasteAll

        ' Set print area for the copied sheet
        TempSheet.PageSetup.PrintArea = TempSheet.UsedRange.Address

        hasData = True
    End If

    ' Check if the temporary workbook has any data
    If Not hasData Then
        MsgBox "Sheet1 has no data to save as PDF.", vbExclamation
        TempWorkbook.Close SaveChanges:=False
        Exit Sub
    End If

    ' Adjust page setup for the sheet in the temporary workbook
    For Each TempSheet In TempWorkbook.Worksheets
        With TempSheet.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    Next TempSheet

    Application.DisplayAlerts = False

    ' Save the temporary workbook as PDF
    TempWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
        fileName:=PDFPath, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    ' Close the temporary workbook without saving
    TempWorkbook.Close SaveChanges:=False

    MsgBox "Sheet1 successfully saved as PDF.", vbInformation
End Sub

' Function to check if the worksheet has any visible data
Private Function WorksheetHasData(ws As Worksheet) As Boolean
    ' Check if UsedRange contains any visible data
    On Error Resume Next
    Dim cell As Range
    Dim isData As Boolean
    isData = False
   
    ' Loop through cells in UsedRange to check for any visible data
    For Each cell In ws.UsedRange
        If Not IsEmpty(cell.Value) Then
            isData = True
            Exit For
        End If
    Next cell
    On Error GoTo 0

    WorksheetHasData = isData
End Function

Private Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Sheets(sheetName)
    SheetExists = Not ws Is Nothing
    On Error GoTo 0
End Function

I had to delete any worksheets in your workbook that are blank. There was only one. A blank worksheet for some reason was creating error messages when
the macro was run.

This macro for some reason thinks the PDF file already exists in the selected folder if the file had been saved there previously using the same name. This can be overcome
by saving to a different folder or changing the name of the saved file, Someone else may be able to overcome this shortcoming. I apologize I couldn't correct this.

Download edited workbook : Internxt Drive – Private & Secure Cloud Storage

Thank you so much! This works perfectly!

 

[Logit]

You are welcome.