Is it Posible to have a message box appear when some click the unprotect sheet button?

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,356
Hi Everyone,

Is it Possible to have a message box appear when someone clicks the unprotect sheet button?

I want to add a worning to say "This Page is Protected for a reason, Do you have permission to unprotect this sheet?" yes/no

can it be done???

thanks

Tony
 

mole999

Moderator
Joined
Oct 23, 2004
Messages
9,899
for the second part of your want
Code:
    Select Case MsgBox("This Page is Protected for a reason, " & vbCrLf _
        & "Do you have permission to unprotect this sheet?", vbYesNo Or vbQuestion, "STOP")

        Case vbYes
            
        Case vbNo

    End Select
install your intended actions after the yes or no markers
 

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,356
Thanks for your help everyone, however unless i'm mistaken this is all to do with selecting a protected cell,

what I'm trying to do is stop people unprotecting the sheet (by knowing the password that they should not have)
and whilst I know I can't 100% stop then I think a message from me saying "why are you trying to unlock this protected page?" would help but I need it triggered whenthey press the "Unprotect sheet" button?

Thanks

Tony
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,272
Thanks for your help everyone, however unless i'm mistaken this is all to do with selecting a protected cell,

what I'm trying to do is stop people unprotecting the sheet (by knowing the password that they should not have)
and whilst I know I can't 100% stop then I think a message from me saying "why are you trying to unlock this protected page?" would help but I need it triggered whenthey press the "Unprotect sheet" button?

Thanks

Tony
Do you mean when they press the "Unprotect sheet" button on the Ribbon?
 

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,356
Yes, there is no reason they should be pressing that button so its just a way of saying "Why are you doing this?"
 

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,356
Thanks Mole,
that's what I need, I'll play about with it until it does what I want.
Thanks for the help, would never have found this.

Tony
 

mole999

Moderator
Joined
Oct 23, 2004
Messages
9,899
quickest maybe to just remove the button on load, need to reinstate on close. it will all work until they start with macros disabled
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,493
Office Version
2016
Platform
Windows
Another way, using a Windows API-timer, without the need to add any XML code to the project or any callbacks.

Place the code below in a new Standard module:
Note: In order for the code to take effect, the Auto_Open Macro below has to be executed either when first opening the workbook or by running the macro directly.

Code:
Option Explicit

Private Type POINTAPI
    x As Long
    Y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal arg1 As LongPtr, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
 
Private Const CHILDID_SELF = &H0&
Private Const S_OK As Long = &H0
Private bEnabeHook As Boolean


Private Sub Auto_Open()
    If Not bEnabeHook Then
        bEnabeHook = True
        SetTimer Application.hwnd, 0, 0, AddressOf HookProc
    End If
End Sub


Private Sub Auto_Close()
    KillTimer Application.hwnd, 0
    bEnabeHook = False
End Sub


Private Sub HookProc()
    Dim oIA As IAccessible
    Dim lResult As Long
    Dim tMousePos As POINTAPI
    
    GetCursorPos tMousePos
    
    #If Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, tMousePos, LenB(tMousePos)
        lResult = AccessibleObjectFromPoint(lngPtr, oIA, 0)
    #Else
        lResult = AccessibleObjectFromPoint(tMousePos.x, tMousePos.Y, oIA, 0)
    #End If
    
    If lResult = S_OK Then
        If InStr(1, oIA.accName(CHILDID_SELF), "Ôter la protection de la feuille", vbTextCompare) Or _
        InStr(1, oIA.accName(CHILDID_SELF), "Unprotect Sheet", vbTextCompare) Then
            If GetAsyncKeyState(VBA.vbKeyLButton) <> 0 Then
                KillTimer Application.hwnd, 0
                If MsgBox("This Page is Protected for a reason." & vbLf & _
                "Do you have permission to unprotect this sheet ?", vbYesNo + vbExclamation) = vbYes Then
                    CommandBars.ExecuteMso ("SheetProtect")
                End If
                SetTimer Application.hwnd, 0, 0, AddressOf HookProc
            End If
        End If
    End If
    
End Sub
Obviously, this requires that Macros be enabled.
 
Last edited:

Forum statistics

Threads
1,081,676
Messages
5,360,441
Members
400,586
Latest member
Minty

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top