Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private lhHook As LongPtr
#Else
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private lhHook As Long
#End If
Private Const WH_CBT = 5&
Private Const HCBT_CREATE = 3&
Public Property Let SuppressSheetProtectionAlert(ByVal Suppress As Boolean)
If Suppress Then
Application.CommandBars("row").Controls(GetInsertMenuIndex).OnAction = "SetHook"
Else
Application.CommandBars("Row").Reset
End If
End Property
Private Sub SetHook()
Call SetCBTHook
Application.CommandBars("Row").Reset
Application.OnTime Now, "ExecuteInsertRow"
End Sub
Private Sub ExecuteInsertRow()
ActiveSheet.Unprotect
Application.CommandBars("row").Controls(GetInsertMenuIndex).Execute
Call RemoveCBTHook
Application.CommandBars("row").Controls(GetInsertMenuIndex).OnAction = "SetHook"
ActiveSheet.Protect
End Sub
Private Function GetInsertMenuIndex() As Long
Dim oCtrl As CommandBarControl
For Each oCtrl In Application.CommandBars("row").Controls
If oCtrl.Caption = "&Insert" Or oCtrl.Caption = "&Rows" Then
If oCtrl.Caption = "&Rows" Then oCtrl.Caption = "&Insert"
GetInsertMenuIndex = oCtrl.Index: Exit Function
End If
Next
End Function
Private Sub SetCBTHook()
UnhookWindowsHookEx lhHook
lhHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
End Sub
Private Sub RemoveCBTHook()
UnhookWindowsHookEx lhHook
End Sub
#If VBA7 Then
Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
Dim sBuffer As String * 256, lRet As Long
If idHook = HCBT_CREATE Then
sBuffer = Space(256)
lRet = GetClassName(wParam, sBuffer, 256)
If Left(sBuffer, lRet) = "#32770" Or Left(sBuffer, lRet) = "MsoCommandBarPopup" Then
Debug.Print "Sheet Protection Alert Aborted !"
HookProc = -1
Exit Function
End If
End If
HookProc = CallNextHookEx(lhHook, idHook, ByVal wParam, ByVal lParam)
End Function
Public Sub CheckBox_Click()
If Sheet1.CheckBoxes(Application.Caller).Value = xlOn Then
SuppressSheetProtectionAlert = True
Else
SuppressSheetProtectionAlert = False
End If
End Sub
Public Sub TickCheckbox(ByVal Tick As Boolean)
Sheet1.CheckBoxes(1).Value = IIf(Tick, xlOn, xlOff)
End Sub