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

[tonywatsonhelp]

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]

for the second part of your want

    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

 

[Logit]

.
Take a look here : https://www.mrexcel.com/forum/excel...rror-message-popup-window-protected-cell.html

 

[tonywatsonhelp]

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]

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]

Yes, there is no reason they should be pressing that button so its just a way of saying "Why are you doing this?"

 

[mole999]

Not an area I have dabbled in > https://www.experts-exchange.com/ar...ents-with-VBA-using-Repurposing-Commands.html

 

[tonywatsonhelp]

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]

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]

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 Autpen Macro below has to be executed either when first opening the workbook or by running the macro directly.

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.