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

 

[Logit]

.
Jaafar .. great code !

Here is a snippet that will also give the OP an opportunity to add a "Yes / No" selection to the MsgBox which can drive another macro (not provided here) asking for a password if the user does have access to edit the worksheet.

Sub MsgYesNoSub()
Dim Ans As Integer


If ActiveSheet.Range("A1").Value = "Correct" Then
    MsgBox "Correct present in A1. Place your script code in this macro location to auto run."
Else
    Ans = MsgBox("Range A1 contains: " & ActiveSheet.Range("A1").Value & vbNewLine & vbNewLine & _
    "Continue Run Script?  Press Yes/No", vbYesNo + vbDefaultButton1, "Run Script? Yes/No")
   
    If Ans = vbYes Then
        MsgBox "You chose yes. Include script macro here or a call to that macro."
    Else
        
        MsgBox "You chose No."
        Exit Sub
    End If
    
End If


End Sub

 

[Jaafar Tribak]

.
Jaafar .. great code !

Thanks for the feedback Logit.

There was a small issue with the code I posted related to the active window which I have now addressed in the following update :

In a Standard module and run the Autpen routine :

Option Explicit

Private Type POINTAPI
    x As Long
    Y As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  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)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  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
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    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
    Private Declare Function GetActiveWindow Lib "user32" () As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  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
    
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, tMousePos, LenB(tMousePos)
        lResult = AccessibleObjectFromPoint(lngPtr, oIA, 0)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        lResult = AccessibleObjectFromPoint(tMousePos.x, tMousePos.Y, oIA, 0)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    If lResult = S_OK Then
        If GetActiveWindow = Application.hwnd 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 If
    
End Sub