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>

 

[Jaafar Tribak]

UPDATE:

I have managed to drastically reduce the size of the dll !

32dll went from 779kb to 71kb
64dll went from 981kb to 84kb

I have deleted the dlls and workbook examples I posted in Box.net in my initial post and have uploaded the new updated versions as follows :

WorkbookExample_64Bits

WorkbookExample_32Bits

 

[Pinaceous]

Hi Jaafar,

I am really impressed by your coding! Thank you for supplying a document to explain your procedures.


It really works very good. I just have a minor question.

How come your code changes the column letters to numbers??

Just curious as to where it is coming from and if you can point it out in your code.

Many thanks again!!

Pinaceous

 

[Jaafar Tribak]

Hi Pinaceous,

I am glad you liked the code and I am happy that it worked for you because I only tested it in Excel French version - wasn't entirely sure it was going to work in English versions as well.

How come your code changes the column letters to numbers??

The code doesn't change the column letters to numbers .. It is just that I used that setting when testing the dll in excel and forgot to restore it back to Letters.
You can simply reset it back to Letters by going to File>Options>Formula> and uncheck the reference style R1C1

 

[Pinaceous]

Hi Jaafar,

You are really 100% right on!

Something else came up with your code that I've noticed.

I am applying your code to a workbook, for example, with 10 named and protected sheets, I've noticed that the error message works on all of the sheets of the workbook that is protected.


So, my question is, is there a way your code can specify which sheets it works on?

For example, can your code be applied to work on all of the even number sheets and not to function on all of the odd number sheets?


Or rather, can your code provide a pop-up for the odd numbered sheets and then a different pop-up for the even sheets, if this is a simpler approach.


Please let me know.

Many thanks in advance!

Pinaceous

 

[Jaafar Tribak]

can your code provide a pop-up for the odd numbered sheets and then a different pop-up for the even sheets, if this is a simpler approach.

Yes. You can do anything you like in the callback procedure: "MyCustomWarningFunc" even executing other macros.

For example, using the index number of the activesheet, you can display different pop-ups for even and odd numbered worksheets as follows :

Private Sub MyCustomWarningFunc()
   MsgBox IIf(ActiveSheet.Index Mod 2 = 0, "Even numbered sheet.", "Odd numbered sheet.")
End Sub

 

[Pinaceous]

Hi Jaafar,

I am totally living up to your cliché on this one!

Now, How do you go about combining your 2nd 'Private Sub My CustomWarningFunc()' with your 1st that you have presented?

I've tried different variations but I can't seem to crack it.

For example:

1st:

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

&


2nd:

Private Sub MyCustomWarningFunc()
    MsgBox IIf(ActiveSheet.Index Mod 2 = 0, "Even numbered sheet.", "STOP.")

End Sub

I thought when combining the 2nd with the 1st, it would come out like this one below, but I'm way off as the excel sheet restarts and crashes:

Private Sub MyCustomWarningFunc()    
    MsgBox IIf(ActiveSheet.Index Mod 2 = 0, "Even numbered sheet.", "STOP !!" & vbLf & vbLf & "'" & ActiveSheet.Name & "' is protected." & vbLf & _
    "This is a user defined warning message.", vbCritical, "XLProtectWarning64 dll (test).")
End Sub

Thank you!!!

 

[Jaafar Tribak]

Hi Pinaceous,
I am not sure what exactly you are trying to do .. Are you wanting to display the custom warning message for even sheets only ?

Word of caution
You must be careful not to have a compile error or an unhadled runtime error in the MyCustomWarningFunc procedure otherwise it will crash the application !

You should test MyCustomWarningFunc procedure before loading the dll .. Once you are sure that the procedure is error free then load the dll via the StartTest macro.

 

[Pinaceous]

Hi Jaafar,

What I was trying to do was to substitute your original pop-up message, into the message that your wrote for the odd numbered sheet popup message.

For example:

I am trying to substitute the display verbiage popup that was used for the original MsgBox code:

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

Into your the new MsgBox IIf, for the odd numbered popup display:

"Odd numbered sheet."

I was trying to accomplish this through a copy/paste but it is not working well.

Any suggestions??

 

[Jaafar Tribak]

Maybe something like this :

Private Sub MyCustomWarningFunc()
    If ActiveSheet.Index Mod 2 <> 0 Then
        MsgBox "STOP !!" & vbLf & vbLf & "'" & ActiveSheet.Name & "' is an odd numbered sheet and is protected." _
        & vbLf & "This is a user defined warning message.", vbCritical, "XLProtectWarning64 dll (test)."
    End If
End Sub