How to hook into sheet protection violation event

A

AnnaHansen

Board Regular
Joined
Oct 27, 2014
Messages
58
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?
 
Sort by date Sort by votes
Jaafar Tribak said:
ok - So did the code work for you as expected in the end ?
Click to expand...
No. every time I open the workbook I get what I described in post 5. If I 'End' the code or just skip that problem line then when I close the workbook I get the same error but on the line of code 2 below the previous yellow one. In between I still get the alert pop up.


This is how I replicated the alert.
- Created a 2-column table (Headers Amt1 and Amt2)
- Entered numbers in the first column
- Selected the first column and formatted the cells to remove the 'Locked' tick
- Entered the following formula in the second column =[@Amt1]*2 leaving 'Locked' set for that column's cells (& the rest of the worksheet)
- Protected the sheet (allowing Insert Rows) but no password
- Right click a row and 'Insert'. Alert appears
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi Peter,

Following the steps you provided, I could now reproduce the sheet protection alert but I couldn't reproduce the runtime error and everything seems to be working as expected.

Here is a working WORKBOOK SAMPLE that you can download and test.

I added a copule of lines to my previous code as follows:

In a Standard Module:
VBA Code: 
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" 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
 
Upvote 0
Ok- I have been able to reproduce the runtime error that happens when first opening the workbook.

For some strange reason, the commanddbarcontrol (ID:=3183) is not recognized when the workbook is saved and reopened.

To remedie this, I have changed the code so it referes to the &Insert commandbar control via its index .... accessing the Insert control via its Index seems to work with no issues.

I have update the workbook download.


So, please ignore all previous codes and use the correct code below :

1- In a Standard Module :
VBA Code: 
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()
    Application.CommandBars("row").Controls(GetInsertMenuIndex).Execute
    Call RemoveCBTHook
    Application.CommandBars("row").Controls(GetInsertMenuIndex).OnAction = "SetHook"
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



2- In the ThisWorkbook Module:
VBA Code: 
Option Explicit

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

Private Sub Workbook_Deactivate()
    Call TickCheckbox(False)
    SuppressSheetProtectionAlert = False
End Sub

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

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Call TickCheckbox(False)
    SuppressSheetProtectionAlert = False
End Sub
 
Upvote 0
It's Excel 2016, and specifically trying to insert a row within a table.


Jaafar Tribak said:
"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) ?
Click to expand...
 
Upvote 0
Yes, only in the table do I want them to be able to add rows. Something like what you have there is exactly what I was thinking, just need to figure out where to put it.



Peter_SSs said:
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.

VBA Code: 
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
Click to expand...
 
Upvote 0
AnnaHansen said:
just need to figure out where to put it.
Click to expand...
Sorry, I meant to include those instructions. :oops:
To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).
 
Upvote 0
Peter_SSs said:
Sorry, I meant to include those instructions. :oops:
To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).
Click to expand...
Thank you, I meant which event to hook into :)
 
Upvote 0
Well, no, but I think what I wanted is actually not doable, like you mentioned in your first replay (i.e., no event to hook into)
 
Upvote 0
So my suggestion in post 3 is not an accepatble alternative?
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA - Table Features Aren't Available Error - Despite Code Running
Replies
1
Views
143
MJaspering
M
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
334
sspatriots
S
D
  • Question
Excel on Mac - file repair issues
Replies
1
Views
1K
dskills
D
T
  • Question
Insert/Delete not available on Protected Sheet
Replies
0
Views
364
tlrowe9065
T
K
  • Question
VBA with password-protected sheet
Replies
5
Views
283
Logit
Logit

Forum statistics

Threads
1,214,974
Messages
6,122,536
Members
449,088
Latest member
RandomExceller01

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top