How to hook into sheet protection violation event

[AnnaHansen]

I have a Table with formulae I do not want my users to edit, but I still want the table to be expandable. However, with locking set correctly, sheet protection turned on and insert new rows allowed, the "The cell or chart you are trying to protect is on a protected sheet....." alert still pops up. (Note, the new row is actually inserted despite the alert display!)

I can't deploy this without suppressing that alert. There must be an event being triggered, which I could hook into and write some code to suppress the alert, but I can't find any documentation it (looked into On Error Go To and Err.Number but could not find the value for this alert).

Any one know?

 

[Jaafar Tribak]

"There must be an event being triggered, which I could hook into... "

Hi,

There is no such event and turning off DisplayAlerts doesn't work either.

I couldn't replicate the issue you are experiencing. With sheet protection turned on and insert new rows allowed, when insert a new row, the alert doesn't come up.

Which excel version are you using and how are you inserting the row(s) ?

 

[Peter_SSs]

As far as I know you cannot suppress such an alert (happy to be proved wrong though)
Would a work-around like this be acceptable?

Unprotect the sheet and then protect it again without the 'Allow row insertion'
Then use instruct your users to double-click a particular column (eg left column) cell in the table where they want to insert a new row after you have installed this event code in the worksheet's module.
I have assumed that it is only in the table that you want to allow row insertion.(??)
Of course you will need to adjust the passwords to match yours.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, ActiveSheet.ListObjects(1).DataBodyRange.Columns(1)) Is Nothing Then
    Cancel = True
    ActiveSheet.Unprotect Password:="abc"
    ActiveSheet.ListObjects(1).ListRows.Add
    ActiveSheet.Protect Password:="abc"
  End If
End Sub

Of course the users will need to have allowed macros but they should soon get used to that otherwise they will not be able to insert rows

 

[Jaafar Tribak]

Another way that works by hooking the (insert-row) from the right-click menu ... It is slightly more involved but should be more intuitive for the user.


1- In a Standard Module :

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.FindControl(ID:=3183).OnAction = "SetHook"
    Else
        Application.CommandBars.FindControl(ID:=3183).OnAction = ""
    End If
End Property

Private Sub SetHook()
    Call SetCBTHook
    Application.CommandBars.FindControl(ID:=3183).OnAction = ""
    Application.OnTime Now, "ExecuteInsertRow"
End Sub

Private Sub ExecuteInsertRow()
    Application.CommandBars.FindControl(ID:=3183).Execute
    Application.CommandBars.FindControl(ID:=3183).OnAction = "SetHook"
    Call RemoveCBTHook
End Sub

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" 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

2- Code Usage in the ThisWorkbook Module:

Note: The following code assumes that the table is in Sheet1 ... Change the sheet in the code as required

Option Explicit

Private Sub Workbook_Activate()
    If ActiveSheet Is Sheet1 Then  '<== Change target Sheet as required !
        SuppressSheetProtectionAlert = True
    End If
End Sub

Private Sub Workbook_Deactivate()
    SuppressSheetProtectionAlert = False
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh Is Sheet1 Then  '<== Change target Sheet as required !
        SuppressSheetProtectionAlert = True
    End If
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    SuppressSheetProtectionAlert = False
End Sub

 

[Peter_SSs]

@Jaafar Tribak
I copied the codes into the modules indicated, saved,closed, reopened. The results was ..

 

[Jaafar Tribak]

@Jaafar Tribak
I copied the codes into the modules indicated, saved,closed, reopened. The results was ..
View attachment 3738

View attachment 3739

That error seems to indicate the ID of the Insert menu is not 3183 which is strange !

Try this and see what you get :

Sub test()

    Dim oCtrl As CommandBarControl
   
    For Each oCtrl In Application.CommandBars("Row").Controls
        Debug.Print oCtrl.Caption; "  ID:" & oCtrl.ID
    Next

End Sub

Note:
BTW, there is no need to hook the insert menu from the Cell context menu as the worksheet is protected therefore the insert entry is greyed out anyway.

 

[Peter_SSs]

Try this and see what you get :

Cu&t ID:21
&Copy ID:19
&Paste ID:22
Paste &Special... ID:21437
&Paste Table ID:3624
Data T&ype ID:32713
&Rows ID:296
&Delete... ID:293
Clear Co&ntents ID:3125
&Format Cells... ID:855
&Row Height... ID:541
&Hide ID:883
&Unhide ID:884
&Remove Hyperlink ID:3626

 

[Jaafar Tribak]

Cu&t ID:21
&Copy ID:19
&Paste ID:22
Paste &Special... ID:21437
&Paste Table ID:3624
Data T&ype ID:32713
&Rows ID:296
&Delete... ID:293
Clear Co&ntents ID:3125
&Format Cells... ID:855
&Row Height... ID:541
&Hide ID:883
&Unhide ID:884
&Remove Hyperlink ID:3626

That is very strange because those controls are for the "Cell" context menu NOT for the "Row" context menu !! (Row menu is the menu that pops up when selecting the row headings)

I am using excel 2016. Which version are you using ?

 

[Peter_SSs]

That is very strange because those controls are for the "Cell" context menu NOT for the "Row" context menu !!

Sorry, I didn't have a row selected before.

Cu&t ID:21
&Copy ID:19
&Paste ID:22
Paste &Special... ID:21437
&Paste Table ID:3624
Data T&ype ID:32713
&Insert ID:3183
&Delete ID:293
Clear Co&ntents ID:3125
&Format Cells... ID:855
&Row Height... ID:541
&Hide ID:883
&Unhide ID:884
&Remove Hyperlinks ID:3626

Which version are you using ?

Look under my avatar.

 

[Jaafar Tribak]

Hi Peter,

ok - So did the code work for you as expected in the end ? or do you, like me, don't experience the popup alert issue the OP is describing so you cannot tell if the code actually works or not ?

Regards.