Option Explicit
Private WithEvents fExcelApp As Application
Private fInputPassword As String, fTruePassword As String
Sub Create(ByVal ExcelApplication As Application)
If Not fExcelApp Is Nothing Then
Destroy
End If
Set fExcelApp = ExcelApplication
If fExcelApp.ActiveWorkbook.ReadOnly Then
'fExcelApp.ActiveWorkbook.ReadOnly = False
End If
MsgBox "All workbooks are locked!", vbExclamation
End Sub
Sub Destroy()
Set fExcelApp = Nothing
End Sub
Private Sub fExcelApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Not (fTruePassword = fInputPassword)
SaveAsUI = Not Cancel
If Cancel Then
If MsgBox("The Save (As...) function is disable." & Chr(13) & _
"Do you want to input password?", vbQuestion + vbYesNo, Wb.Name) = vbYes Then
ShowInputPassword
Cancel = Not (fTruePassword = fInputPassword)
SaveAsUI = Not Cancel
End If
End If
End Sub
Private Sub Class_Initialize()
'Do...
End Sub
Private Sub Class_Terminate()
Destroy
End Sub
Property Get TruePassword() As String
TruePassword = fTruePassword
End Property
Property Let TruePassword(ByVal Value As String)
fTruePassword = Value
End Property
Property Get InputPassword() As String
InputPassword = fInputPassword
End Property
Property Let InputPassword(ByVal Value As String)
fInputPassword = Value
End Property
Sub ShowInputPassword()
fInputPassword = fExcelApp.InputBox("Your password:")
End Sub