Change the built-in protected worksheet warning message.

[Jaafar Tribak]

Hi all,

I have written a C++ dll that can be used from VBA to abort\change the default worksheet protected warning message.

XLProtectWarning32.dll
XLProtectWarning64.dll

#include "Header.h"
#include windows.h<windows.h><windows.h>
#define DLL_EXPORTS

HHOOK hookHandle = NULL;
HMODULE hInstance = NULL;
WNDPROC callback = NULL;
BOOL HookSet = NULL;

LRESULT CALLBACK CBTProc(int nCode, WPARAM wParam, LPARAM lParam) {
    WCHAR clsName_v[MAX_PATH];
    CHAR buffer[MAX_PATH];
    static INT i;

    if (nCode == HCBT_ACTIVATE) {
        GetClassName(HWND(wParam), clsName_v, MAX_PATH);
        if (0 == lstrcmp(clsName_v, TEXT("#32770"))) {
            HWND msgHwnd = 0;
            msgHwnd = GetDlgItem(HWND(wParam), 0x0000000000000FA1);
            if (!IsWindow(msgHwnd)) { msgHwnd = GetDlgItem(HWND(wParam), 0x000000000000FFFF); }
            GetWindowTextA(msgHwnd, buffer, MAX_PATH);
            if ((strncmp(buffer, "La cellule ou le graphique", 26) == 0) || (strncmp(buffer, "The cell or chart", 17) == 0)) {
                if (callback != NULL) {
                    if (i % 3 == 0) { CallWindowProc(callback, 0, 0, 0, 0); }
                    i = i + 1;
                }
                DestroyWindow((HWND)wParam);
                return -1;
            }
        }
    }
    return CallNextHookEx(hookHandle, nCode, wParam, lParam);
}

void __stdcall AbortProtectWarning(BOOL Enable, WNDPROC CallBackFunc = NULL)
{
    callback = CallBackFunc;
    if ((Enable) && (!HookSet)) {
        hInstance = GetModuleHandle(L"XLProtectWarning32.dll");
        hookHandle = SetWindowsHookEx(WH_CBT, (HOOKPROC)CBTProc, hInstance, 0);
        HookSet = TRUE;
    }
    if ((!Enable) && (HookSet)) { UnhookWindowsHookEx(hookHandle); HookSet = FALSE; }
}

The dll exports one function (AbortProtectWarning) which installs/Removes a WH_CBT hook that swallows the built-in message and calls an alternative user defined Procedure.

The reason I installed the hook in a dll is so that excel doesn't crash should the VBE get reset accidently.

USAGE:

Note that the dll doesn't require prior registration as it is a standard windows dll.

For portability reasons, I decided to store the dll bytes in a hidden worksheet of the workbook (like a resource) and then have the vba code save the dll file to disk from the bytes on the fly.

The only issue is the size of the dll (779 kb for the 32.dll) - (981 kb for the 64.dll) which can bloat the workbook... If I manage to reduce the dll size, I'll post the result here later.

If you don't want to deal with this sizing problem, just remove the bytes from the hidden worksheet , have the dll as a seperate file and call the dll function (AbortProtectWarning) as normal.

Anyways, here are 2 workbook examples for 32Bits and 64Bits:

A32.xlsm
A64.xlsm

32Bit code:

Option Explicit

Private Declare Function DispCallFunc Lib "OleAut32.dll" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc_ As Long, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Integer, ByRef prgpvarg As Long, ByRef pvargResult As Long) As Long
Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Const LOAD_IGNORE_CODE_AUTHZ_LEVEL = &H10
Private Const CC_STDCALL = 4

Sub StartTest()
    Dim hLib As Long, pProcAddr As Long
    Dim sFilePathName As String

    sFilePathName = ThisWorkbook.Path & "\XLProtectWarning32.dll"

    If Len(Dir(sFilePathName)) = 0 Then
        Call CreateDllFromBytes(sFilePathName)
    End If
    
    hLib = GetProp(Application.hwnd, "hLib")
    pProcAddr = GetProp(Application.hwnd, "pProcAddr")

    If hLib = 0 Then
        hLib = LoadLibraryEx(sFilePathName, 0, LOAD_IGNORE_CODE_AUTHZ_LEVEL)
        If hLib Then
            pProcAddr = GetProcAddress(hLib, "AbortProtectWarning")
            SetProp Application.hwnd, "hLib", hLib
            If pProcAddr Then
                CallDllProc pProcAddr, True, AddressOf MyCustomWarningFunc
                SetProp Application.hwnd, "pProcAddr", pProcAddr
            End If
        End If
    End If
End Sub

Sub StopTest()
    Dim hLib As Long, pProcAddr As Long

    hLib = GetProp(Application.hwnd, "hLib")
    pProcAddr = GetProp(Application.hwnd, "pProcAddr")
    
    If hLib Then
        If pProcAddr Then
            CallDllProc pProcAddr, False, AddressOf MyCustomWarningFunc
            FreeLibrary hLib
            RemoveProp Application.hwnd, "hLib"
            RemoveProp Application.hwnd, "pProcAddr"
        End If
    End If
End Sub

Private Sub MyCustomWarningFunc()
    MsgBox "STOP !!" & vbLf & vbLf & "'" & ActiveSheet.Name & "' is protected." & vbLf & _
    "This is a user defined warning message.", vbCritical, "XLProtectWarning64 dll (test)."
End Sub

 
Private Sub CreateDllFromBytes(ByVal PathFileName As String)
    Dim arBytes() As Byte, arTemp() As Variant
    Dim lFileNum As Integer, i As Long
    
    arTemp = DllBytes.UsedRange.SpecialCells(xlCellTypeConstants).Value
    ReDim arBytes(LBound(arTemp) To UBound(arTemp))
    For i = LBound(arTemp) To UBound(arTemp)
        arBytes(i) = CByte(arTemp(i, 1))
    Next
    Erase arTemp
    
    lFileNum = FreeFile
    Open PathFileName For Binary As #lFileNum
        Put #lFileNum, 1, arBytes
    Close lFileNum
    Erase arBytes
End Sub

Private Sub CallDllProc(ByVal pProcAddr As Long, ByVal Param1 As Boolean, ByVal Param2 As Long)
    Dim varTypes(0 To 1) As Integer
    Dim varPointers(0 To 1) As Long
    Dim vX As Variant, vY As Variant
    
    vX = CVar(Param1): vY = CVar(Param2)
    varTypes(0) = VBA.vbBoolean
    varTypes(1) = VBA.vbLong
    varPointers(0) = VarPtr(vX)
    varPointers(1) = VarPtr(vY)

   Call DispCallFunc( _
        0, _
        pProcAddr, _
         CC_STDCALL, _
        VbVarType.vbEmpty, _
        2, _
        varTypes(0), _
        varPointers(0), _
        0)
End Sub

64Bit code:

Option Explicit

Private Declare PtrSafe Function DispCallFunc Lib "OleAut32.dll" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc_ As Long, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Integer, ByRef prgpvarg As LongPtr, ByRef pvargResult As LongPtr) As Long
Private Declare PtrSafe Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As LongPtr, ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr

Private Const LOAD_IGNORE_CODE_AUTHZ_LEVEL = &H10
Private Const CC_STDCALL = 4

Sub StartTest()
    Dim hLib As LongPtr, pProcAddr As LongPtr
    Dim sFilePathName As String

    sFilePathName = ThisWorkbook.Path & "\XLProtectWarning64.dll"

    If Len(Dir(sFilePathName)) = 0 Then
        Call CreateDllFromBytes(sFilePathName)
    End If
    
    hLib = GetProp(Application.hwnd, "hLib")
    pProcAddr = GetProp(Application.hwnd, "pProcAddr")

    If hLib = 0 Then
        hLib = LoadLibraryEx(sFilePathName, 0, LOAD_IGNORE_CODE_AUTHZ_LEVEL)
        If hLib Then
            pProcAddr = GetProcAddress(hLib, "AbortProtectWarning")
            SetProp Application.hwnd, "hLib", hLib
            If pProcAddr Then
                CallDllProc pProcAddr, True, AddressOf MyCustomWarningFunc
                SetProp Application.hwnd, "pProcAddr", pProcAddr
            End If
        End If
    End If
End Sub

Sub StopTest()
    Dim hLib As LongPtr, pProcAddr As LongPtr

    hLib = GetProp(Application.hwnd, "hLib")
    pProcAddr = GetProp(Application.hwnd, "pProcAddr")
    
    If hLib Then
        If pProcAddr Then
            CallDllProc pProcAddr, False, AddressOf MyCustomWarningFunc
            FreeLibrary hLib
            RemoveProp Application.hwnd, "hLib"
            RemoveProp Application.hwnd, "pProcAddr"
        End If
    End If
End Sub

Private Sub MyCustomWarningFunc()
    MsgBox "STOP !!" & vbLf & vbLf & "'" & ActiveSheet.Name & "' is protected." & vbLf & _
    "This is a user defined warning message.", vbCritical, "XLProtectWarning64 dll (test)."
End Sub

 
Private Sub CreateDllFromBytes(ByVal PathFileName As String)
    Dim arBytes() As Byte, arTemp() As Variant
    Dim lFileNum As Integer, i As Long
    
    arTemp = DllBytes.UsedRange.SpecialCells(xlCellTypeConstants).Value
    ReDim arBytes(LBound(arTemp) To UBound(arTemp))
    For i = LBound(arTemp) To UBound(arTemp)
        arBytes(i) = CByte(arTemp(i, 1))
    Next
    Erase arTemp
    lFileNum = FreeFile
    Open PathFileName For Binary As #lFileNum
        Put #lFileNum, 1, arBytes
    Close lFileNum
    Erase arBytes
End Sub

Private Sub CallDllProc(ByVal pProcAddr As LongPtr, ByVal Param1 As Boolean, ByVal Param2 As LongLong)
    Dim varTypes(0 To 1) As Integer
    Dim varPointers(0 To 1) As LongPtr
    Dim vX As Variant, vY As Variant

    vX = CVar(Param1): vY = CVar(Param2)
    varTypes(0) = VBA.vbBoolean
    varTypes(1) = VBA.vbLongLong
    varPointers(0) = VarPtr(vX)
    varPointers(1) = VarPtr(vY)

   Call DispCallFunc( _
        0, _
        pProcAddr, _
         CC_STDCALL, _
        VbVarType.vbEmpty, _
        2, _
        varTypes(0), _
        varPointers(0), _
        0)
End Sub

</windows.h></windows.h>

 

[Pinaceous]

Hi Jaafar,

Many thanks for your valued input!

The

If ActiveSheet.Index Mod 2

does a very nice job.

Thank you for making this more commonsensical for me and those your reference this string!

Keep coding on!
Pinaceous

 

[Pinaceous]

Hi Jaafar,

I have a question about your codes that you posted here.

The ones posted for the 32 and 64 bits.

I'm using the 32 bit for excel code and sometimes I'm getting a

Microsoft VB Run-time error '1004': MsgBox popup:

You cannot used the command on a protected sheet. To use this command, you must first unprotect the sheet (Review tab, Changes group, Unprotect Sheet button).
You may be prompted for a password.

Where, I'm using different workstations with other users on a shared drive, if this helps add any information to your thoughts.

Any thoughts??

Many thanks,
Pinaceous

 

[Jaafar Tribak]

Hi Jaafar,

I have a question about your codes that you posted here.

The ones posted for the 32 and 64 bits.

I'm using the 32 bit for excel code and sometimes I'm getting a




Where, I'm using different workstations with other users on a shared drive, if this helps add any information to your thoughts.

Any thoughts??

Many thanks,
Pinaceous

That popup means that the code didn't work. It is difficult for me to know the reason specially that no error is thrown.

 

[Pinaceous]

Hi Jaafar,

That is not a problem, totally understandable. I have the feeling its probably the computers because I've noticed when I was on older and slower ones that message would pop up. Likewise, I've noticed if the computers are newer and faster, it works fine whereas that message doesn't appear.

Thanks again!
Pinaceous

 

[Pinaceous]

Hi Jaafar,

Is there anyway to add to your code, where if there is A

Microsoft VB Run-time error '1004': MsgBox popup

Where upon the error it can provide:

    On Error GoTo Whoa
    
    
Whoa:
    MsgBox Err.Description
    Resume LetsContinue

AND/Or if prevent that popup from surfacing and to skip it:

Application.ScreenUpdating = False
Application.EnableEvents = False

'MsgBox ("Not Running!") -> optional ???
 
Application.ScreenUpdating = True
Application.EnableEvents = True

 
    Exit Sub

IF you can adjust your code to these parameters, that could make a difference and possibly contribute to why it would not work in some instances.

Many thanks,

Pinaceous

 

[Jaafar Tribak]

Hi piaceous,

I am not quite clear about the problem. Are you saying that you are getting a runtime error 1004 when trying to edit the protected worksheet ?

If so, is the error generated in the "MyCustomWarningFunc" callback routine ? and have you tried handling the error with on Error Goto or On Error Resume next etc ?

 

[Pinaceous]

Hi Jaafar,

In running the Sub StartTest() on my document, with the debug it highlights the

Private Sub CreateDllFromBytes(ByVal PathFileName As String)

on the line:

arTemp = DllBytes.UsedRange.SpecialCells(xlCellTypeConstants).Value

.

However, when I run your

B32.xlsm

with your Sub StartTest() I get no such error. So I'd suspect that it has something to do with what I'm doing on the workbook. But I can't seem to figure it out.

Do you have any suggestions?

Thanks very much.
Pinaceous

 

[Jaafar Tribak]

Hi Pinaceous,

I think you are getting that error because you don't have the DllBytes worksheet in your workbook.

You will need to copy the hidden "DllBytes" worksheet from the demo workbook (either the 32bit or the 64bit depending on your system) and add it to your workbook .. Make sure the name of this copied worksheet is exactly "DllBytes"

The hidden DllBytes worksheet is where the dll file bytes are stored.

 

[Pinaceous]

Hi Jaafar Tribak,​

I'm need to convert your code from 32Bit code

to your 64Bit code.


Thank you for supplying both codes above, however the files are not available anymore on this string.

Do you know if you can somehow repost your DllBytes for the 64Bit code or do you mind reposting your:

XLProtectWarning64.dll &

A64.xlsm ??


Many thanks!
Pinaceouse

 

[Jaafar Tribak]

Hi Jaafar Tribak,​

I'm need to convert your code from 32Bit code

to your 64Bit code.


Thank you for supplying both codes above, however the files are not available anymore on this string.

Do you know if you can somehow repost your DllBytes for the 64Bit code or do you mind reposting your:

XLProtectWarning64.dll &

A64.xlsm ??


Many thanks!
Pinaceouse

Hi Pinaceouse,

I am afraid, I lost the workbook .

To be honest, I think that using a dll and going through all that code in order to simply suppress the native excel warning is overkill. The real reason I took the dll approach was maily for experimenting. Basically, what the dll code does is set up a windows hook (HCBT_ACTIVATE) to intercept the creation\activation of the standard protected worksheet warning and optionally replace it with your own custom message. This certainely could be achieved from within vba but it is risky and will never recommend it. Probably, a better approach is to run the code from a second hidden intance of excel so that it remains safe and stable even when\If an unhandled error occurs .

If I have time, I 'll give that a shot, although I still think this whole stuff is overkill.

Regards.