Disabled Save As&Save but now my Save button macro won't run

[Realtreegirl75]

I have a report that I have created that does a lot of things in the back end that I need people to stop using the "Save" or "Save As" Buttons in the ribbon to bypass. I just found this and it disables Save and Save As (but adds the ability to use a password to bypass the disabled functions) so that the user has to use the macro button that does all the back-end stuff that needs to be done:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If SaveAsUI = True Then
Cancel = True
MsgBox ("Save as function is disabled.")
ElseIf ThisWorkbook.Saved = True Then
a = InputBox("password:", "you need a password to save this workbook")
If a = "123" Then
MsgBox ("workbook is saved.")
Else
Cancel = True
MsgBox ("Workbook isn't saved.")
End If
End If

End Sub

This is the code I have tied to my macro-save button. It pulls information from the report to save the file but lets the user save the file in whatever location they want. It also ends the sub if the user clicks "Cancel" instead of saving the report:

Sub Test_Save()

Dim tdayName As String
Dim no1 As String
Dim tday As String
Dim no2 As String
Dim tmrName As String
Dim tmr As String
Dim FolderPath1 As String

If Val(Application.Version) > 15 Then
    If ActiveWorkbook.AutoSaveOn Then ActiveWorkbook.AutoSaveOn = False
End If

no1 = Range("r3").Text
tday = Range("ac4").Text
no2 = Range("E6").Text
tmr = Range("T237").Text
FolderPath1 = Application.ThisWorkbook.Path & "/"
tdayName = "DIR - " & no1 & " - " & tday & " - " & no2
tmrName = "DIR - " & no1 & " - " & tmr & " - " & no2

Application.DisplayAlerts = False

FileSaveName = Application.GetSaveAsFilename(InitialFileName:=tdayName, filefilter:="Excel Files(*.xlsm),*.xlsm", Title:="Please save the file")
If FileSaveName = False Then Exit Sub
ThisWorkbook.SaveAs Filename:=FileSaveName, FileFormat:=52

If Val(Application.Version) > 15 Then
    If ActiveWorkbook.AutoSaveOn Then ActiveWorkbook.AutoSaveOn = False
End If
End Sub

So now I'm left with the question of how to get my button to run. Anyone have any ideas? Or suggestions about how I'm going about this in an entirely useless and round-about way?

 

[rlv01]

So now I'm left with the question of how to get my button to run. Anyone have any ideas? Or suggestions about how I'm going about this in an entirely useless and round-about way?

How to run the macro? What is preventing you from putting Sub Test_Save in a standard code module and assigning a form button to it? And why do you want a password to save? I can tell you that if I were a user who just spent an hour working on my spreadsheet only to be prevented from saving it at the last minute, my anger at the programmer would be hotter than the sun. Better to put any authorized user/password access scheme at the front end and not allow editing to begin.

 

[Realtreegirl75]

Thats what I did. I have the Sub Test_Save in its own module but because save and save as is disabled by the Before_Save, the Sub Test_Save won't run. (Sorry, I'm not sure how to format the sub names as you have above)

We had problems in our program all of 2023 of users using the normal save button to bypass the macros that ensure the report is filled out correctly. Due to this, we had incomplete reporting, incorrect reports, and all of the stuff we do on the back end with them was a huge headache because we had to fix an astounding amount of reports manually. The users will be informed that the standard save option is disabled and the only way to save is the Sub Test_Save button; it won't be a surprise. I'm also not opposed to eliminating the password option, but there again, I can't have users bypassing the Sub Test_Save and continue to turn in incomplete reports.

But that still leaves the issue that the Before_Save disables the button that runs Sub Test_Save. How do I get around that?

 

[rlv01]

I'm also not opposed to eliminating the password option, but there again, I can't have users bypassing the Sub Test_Save and continue to turn in incomplete reports.

I understand making a custom save function for the user to use, but not demanding a password. Any knowledgeable user will think of ways to save the data by other means. Besides, the point of a password it to eliminate unauthorized users, and that is better done on the front end.

For the rest, I would probably take a slightly different approach.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    MsgBox "Pleae use the special 'Save' button. " & vbCrLf _
         & "" & vbCrLf _
         & "Workbook not saved. ", vbOKOnly Or vbInformation, Application.Name
    Cancel = True
End Sub

Button Code

Sub Test_Save()

    Dim tdayName As String
    Dim no1 As String
    Dim tday As String
    Dim no2 As String
    Dim tmrName As String
    Dim tmr As String
    Dim FolderPath1 As String, FileSaveName As String

    If Val(Application.Version) > 15 Then
        If ActiveWorkbook.AutoSaveOn Then ActiveWorkbook.AutoSaveOn = False
    End If

    no1 = Range("r3").Text
    tday = Range("ac4").Text
    no2 = Range("E6").Text
    tmr = Range("T237").Text
    FolderPath1 = Application.ThisWorkbook.Path & "/"
    tdayName = "DIR - " & no1 & " - " & tday & " - " & no2
    tmrName = "DIR - " & no1 & " - " & tmr & " - " & no2

    Application.DisplayAlerts = False

    FileSaveName = Application.GetSaveAsFilename(InitialFileName:=tdayName, filefilter:="Excel Files(*.xlsm),*.xlsm", Title:="Please save the file")
    If FileSaveName = "False" Then Exit Sub

    ThisWorkbook.SaveCopyAs (FileSaveName)
    DoEvents                                          'optional

    MsgBox "Workbook saved as:" & vbCrLf & vbCrLf _
         & FileSaveName, vbOKOnly Or vbInformation, Application.Name

    If Val(Application.Version) > 15 Then
        If ActiveWorkbook.AutoSaveOn Then ActiveWorkbook.AutoSaveOn = False
    End If
End Sub

 

[Realtreegirl75]

Thank you, rlv01! This solved all of the issues that I was having! Your code will work perfectly!!

 

[rlv01]

You're welcome.