Protection > Tough one

MarkAndrews

Well-known Member
Joined
May 2, 2006
Messages
1,963
For me anyway

Is there a way I can include an message box into my Workbook_open event which would ask the user if they want to unprotect the sheet?

Yes/No

If Yes, then display a box for them to type the password which will unprotect specified sheets

On workbook_beforeclose, do the opposite of above?

I am stumped

TIA
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

njimack

Well-known Member
Joined
Jun 17, 2005
Messages
7,764
I have the following in my personal.xls

Note: the 2nd portion of code creates an input box which masks the input using asterix's

Code:
Sub Protect_This_Sheet()
Dim myPassword As String
   
    myPassword = InputBoxDK("Please enter your password" & vbCrLf & _
                          "(Make sure you don't forget it)", "Enter Password")
    If myPassword = "" Then
        If MsgBox("You have not entered a password, do you want to proceed?     " & vbCrLf & _
                  "(Passwords are not necessary for minimal protection)", vbQuestion + vbYesNo, _
                  "Protect All Sheets") = vbNo Then Exit Sub
    End If

ActiveSheet.Protect (myPassword)
End Sub

Code:
Option Explicit
'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////


'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then 'A window has been activated

RetVal = GetClassName(wParam, strClassName, lngBuffer)

If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox

'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If

End If

'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long

lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)

hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook

End Function
 

MarkAndrews

Well-known Member
Joined
May 2, 2006
Messages
1,963
Neil thanks for this - It doesn't like this line when using F8 through the code

myPassword = InputBoxDK("Please enter your password" & vbCrLf & _

Specifically InputBoxDK

???

Can i use this on multiple sheets?
 

lozzablake

Well-known Member
Joined
Dec 15, 2005
Messages
818
You need to use the workbook open event and workbook beforeclose event. Something like these which need to go into the module for the workbook. You should password protect the code otherwise anyone can open the VBE and read the password in the code:
Code:
Private Sub Workbook_Open()
    Dim varAnswer
    Dim blnOK As Boolean
    Dim ws As Worksheet
    
        
    'keep looping until input is OK
    blnOK = False
    
    Do
        'get user input
        varAnswer = MsgBox("Do you wish to unprotect the sheets?", vbYesNo)
                
        'check for allowed entry
        If varAnswer = vbYes Then
            'check for password
            varAnswer = InputBox("please input the password")
            If varAnswer = "password" Then   'change for your password
                blnOK = True
                For Each ws In ThisWorkbook.Sheets  'change for specific sheets as required
                    'may need password as argument in unprotect method
                    ws.Unprotect (varAnswer)
                Next ws
            Else
                MsgBox "Incorrect password - returning to Starting menu"
            
            End If
        Else
            blnOK = True
        End If
    
    Loop Until blnOK
        
End Sub

and

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim varAnswer
    Dim blnOK As Boolean
    Dim ws As Worksheet
    
        
    'keep looping until input is OK
    blnOK = False
    
    Do
        'get user input
        varAnswer = MsgBox("Do you wish to protect the sheets?", vbYesNo)
                
        'check for allowed entry
        If varAnswer = vbYes Then
            'check for password
            varAnswer = InputBox("please input the password")
            If varAnswer = "password" Then   'change for your password
                blnOK = True
                For Each ws In ThisWorkbook.Sheets  'change for specific sheets as required
                    'may need password as argument in unprotect method
                    ws.Protect (varAnswer)
                Next ws
            Else
                MsgBox "Incorrect password - returning to Starting menu"
            
            End If
        Else
            blnOK = True
        End If
    
    Loop Until blnOK
        
End Sub
 

Forum statistics

Threads
1,141,592
Messages
5,707,287
Members
421,500
Latest member
Alex2302

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top