Hi all... I've managed to create a macro that does the following:
- If the file type is xlsm, only allow the user to save as an xlsm
- If the file type is any other type (this will only be xltm), prompt for a password;
- If the password is correct, allow the user to save as any file type (I will be the only person who knows the password);
- If the password is incorrect, only allow the user to save as an xlsm
This basically means that if the user opens the template, they can only save as an xlsm, but if they've already saved it as an xlsm, no password input box pops up when they go to save it.
The code is as follows:
Where Range("A4") contains a formula that works out the file type (using cell function). So basically the whole macro works beautifully when it's not a Private Sub and doesn't have the (ByVal SaveAsUI As Boolean, Cancel As Boolean) bit at the end. So when I press play in the VBA editor it works smoothly and if I assigned it to a button in my spreadsheet it would work beautifully...but when I make it work automatically it seems to shut excel down (i.e. cause it to freeze). It also seems to request me to enter the password twice.
Any help would be greatly appreciated?
- If the file type is xlsm, only allow the user to save as an xlsm
- If the file type is any other type (this will only be xltm), prompt for a password;
- If the password is correct, allow the user to save as any file type (I will be the only person who knows the password);
- If the password is incorrect, only allow the user to save as an xlsm
This basically means that if the user opens the template, they can only save as an xlsm, but if they've already saved it as an xlsm, no password input box pops up when they go to save it.
The code is as follows:
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.Calculate
Dim fName As String
If Sheets("File Information").Range("A4").Value = "xlsm" Then
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
MsgBox "You pressed cancel", vbOKOnly
Cancel = True
Exit Sub
Else
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.EnableEvents = True
End If
Else
Dim MyPassword
MyPassword = InputBox("Please enter password", "Password Prompt", "********")
'hardcode password
If MyPassword = "bpscortum" Then
MsgBox "Access Granted", vbInformation, "Access"
'call macro
Application.Dialogs(xlDialogSaveAs).Show
GoTo Finish:
Else
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
MsgBox "You pressed cancel", vbOKOnly
Cancel = True
Exit Sub
Else
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.EnableEvents = True
End If
End If
End If
Finish:
Application.Calculate
End SubWhere Range("A4") contains a formula that works out the file type (using cell function). So basically the whole macro works beautifully when it's not a Private Sub and doesn't have the (ByVal SaveAsUI As Boolean, Cancel As Boolean) bit at the end. So when I press play in the VBA editor it works smoothly and if I assigned it to a button in my spreadsheet it would work beautifully...but when I make it work automatically it seems to shut excel down (i.e. cause it to freeze). It also seems to request me to enter the password twice.
Any help would be greatly appreciated?