Change the built-in protected worksheet warning message.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,779
Office Version
  1. 2016
Platform
  1. Windows
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

Code:
#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:
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:
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>
 
Hi Jaafar Tribak,

Oh, that is to bad that you lost the file(s).

I do have the 32 bit dll information from your last and was hoping to upgrade your code to the 64 bit version.

Yes, please keep me posted!

Appreciate your coding skills!

-pinaceous
 
Upvote 0

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Hi Jaafar Tribak,

All the files are posted here even the 64 bit version!

Appreciate your coding skills!

I'm sorry about that!


-pinaceous
 
Upvote 0
Hi @Pinaceous

Thanks for the feedback.

If you are still interested in this, I would suggest to use this less invasive approach.

CustomSheetProtectionWarningMessage.xlsm

1- Class Code: [clsCustomProtectiontMessage]
VBA Code:
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

#If Win64 Then
    Private Type MSG
        hwnd As LongLong
        message As Long
        wParam As LongLong
        lParam As LongLong
        time As Long
        pt As POINTAPI
    End Type
#Else
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
#End If

#If VBA7 Then
    Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Private Declare PtrSafe Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    
    Private hwnds() As LongPtr
#Else
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
    Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    
    Private hwnds() As Long
#End If

Private bLooping As Boolean, bExitLoop As Boolean
Private Wb As Workbook, Sh As Worksheet
Private WithEvents cmbrs As CommandBars
Event CustomProtectedSheetWarning()


'_________________________________________ PUBLIC CLASS METHODS ____________________________________

Public Sub ProcessMessages(ByVal WS As Worksheet)
    Const PM_NOREMOVE = &H0
    Const WM_KEYDOWN = &H100
    Const WM_LBUTTONDBLCLK = &H203
    Const WM_CHAR = &H102
    Dim tMsg As MSG
    
    Set Sh = WS
    Set Wb = WS.Parent
    Set cmbrs = Application.CommandBars
    
    Do While Not bExitLoop
        If Not IsOk Then GoTo Xit
        bLooping = True
        Call WaitMessage
        If PeekMessage(tMsg, 0, 0, 0, PM_NOREMOVE) Then
            Call TranslateMessage(tMsg)
            Select Case tMsg.message
                Case WM_KEYDOWN
                    If PeekMessage(tMsg, 0, WM_CHAR, WM_CHAR, PM_NOREMOVE) Then
                        RaiseEvent CustomProtectedSheetWarning
                    End If
                Case WM_LBUTTONDBLCLK
                    RaiseEvent CustomProtectedSheetWarning
            End Select
        End If
        DoEvents
    Loop
Xit:
    Set cmbrs = Application.CommandBars
    bLooping = False
End Sub

Public Sub StopProcessing()
    bExitLoop = True
    bLooping = False
End Sub


'_________________________________________ PRIVATE CLASS FUNCTIONS ____________________________________

Private Sub cmbrs_OnUpdate()
    With ActiveWindow.RangeSelection
        If .Parent Is Sh Then
            If IsNull(.Locked) Or .Locked Then
                bExitLoop = False
                Call ProcessMessages(Sh)
            End If
        End If
    End With
End Sub

#If Win64 Then
    Private Function GetHwnds(ByVal Wb As Workbook) As LongLong()
    Dim hTmpArray() As LongLong
#Else
    Private Function GetHwnds(ByVal Wb As Workbook) As Long()
    Dim hTmpArray() As Long
#End If

    Dim oWind As Window
    Dim i As Long
    
    ReDim hTmpArray(Wb.Windows.Count)
    For i = 0 To Wb.Windows.Count - 1
        hTmpArray(i) = Wb.Windows(i + 1).hwnd
    Next i
    GetHwnds = hTmpArray
End Function

Private Function IsWbWindActive() As Boolean
    #If Win64 Then
        Dim hTmpArray() As LongLong
    #Else
        Dim hTmpArray() As Long
    #End If

    hTmpArray = GetHwnds(Wb)
    IsWbWindActive = Not IsError(Application.Match(GetActiveWindow, hTmpArray, 0))
End Function

Private Function IsBackstageView() As Boolean
    IsBackstageView = CBool(FindWindowEx(Application.hwnd, 0, "FullpageUIHost", vbNullString))
End Function

Private Function IsVBEActive() As Boolean
    IsVBEActive = CBool(FindWindow("wndclass_desked_gsk", vbNullString) = GetActiveWindow)
End Function

Private Function IsOk() As Boolean
    Dim bOk As Boolean
    bOk = Sh.ProtectContents
    With Application.ActiveWindow.RangeSelection
        bOk = bOk And (IsNull(.Locked) Or .Locked)
    End With
    bOk = bOk And IsWbWindActive
    bOk = bOk And (ActiveSheet Is Sh)
    bOk = bOk And Not IsVBEActive
    bOk = bOk And Not IsBackstageView
    IsOk = bOk
End Function


2- Code Usage Example [ThisWorkBook Module]
VBA Code:
Option Explicit

Private WithEvents oInstance As clsCustomProtectiontMessage

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Call StartMonitoring
End Sub

Private Sub StartMonitoring()
    If Not oInstance Is Nothing Then
        oInstance.StopProcessing
    End If
    Set oInstance = New clsCustomProtectiontMessage
    Call oInstance.ProcessMessages(WS:=Sheet1) '<<= change target sheet as needed.
End Sub


'________________________________ CUSTOM EVENT _____________________________________
Private Sub oInstance_CustomProtectedSheetWarning()
    MsgBox "This is a custom sheet-protection message.", vbInformation
End Sub


Note: This custom sheet-protection message doesn't work when using drag and drop or autofill... If I have later on, I will see if I can find a way to also intercept those two commands.

Regards.
 
Upvote 0
Hi @Pinaceous

Thanks for the feedback.

If you are still interested in this, I would suggest using this less invasive approach.

CustomSheetProtectionWarningMessage.xlsm


1- Class Code: [clsCustomProtectiontMessage]
VBA Code:
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

#If Win64 Then
    Private Type MSG
        hwnd As LongLong
        message As Long
        wParam As LongLong
        lParam As LongLong
        time As Long
        pt As POINTAPI
    End Type
#Else
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
#End If

#If VBA7 Then
    Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Private Declare PtrSafe Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    
    Private hwnds() As LongPtr
#Else
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
    Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    
    Private hwnds() As Long
#End If

Private bLooping As Boolean, bExitLoop As Boolean
Private Wb As Workbook, Sh As Worksheet
Private WithEvents cmbrs As CommandBars
Event CustomProtectedSheetWarning()


'_________________________________________ PUBLIC CLASS METHODS ____________________________________

Public Sub ProcessMessages(ByVal WS As Worksheet)
    Const PM_NOREMOVE = &H0
    Const WM_KEYDOWN = &H100
    Const WM_LBUTTONDBLCLK = &H203
    Const WM_CHAR = &H102
    Dim tMsg As MSG, tCurPos As POINTAPI
    
    Set Sh = WS
    Set Wb = WS.Parent
    Set cmbrs = Application.CommandBars
    
    Do While Not bExitLoop
        If Not IsOk Then GoTo Xit
        bLooping = True
        Call WaitMessage
        If PeekMessage(tMsg, 0, 0, 0, PM_NOREMOVE) Then
            Call TranslateMessage(tMsg)
            Select Case tMsg.message
                Case WM_KEYDOWN
                    If PeekMessage(tMsg, 0, WM_CHAR, WM_CHAR, PM_NOREMOVE) Then
                        RaiseEvent CustomProtectedSheetWarning
                    End If
                Case WM_LBUTTONDBLCLK
                    Call GetCursorPos(tCurPos)
                    If TypeName(ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)) = "Range" Then
                        RaiseEvent CustomProtectedSheetWarning
                    End If
            End Select
        End If
        DoEvents
    Loop
Xit:
    Set cmbrs = Application.CommandBars
    bLooping = False
End Sub

Public Sub StopProcessing()
    bExitLoop = True
    bLooping = False
End Sub

'_________________________________________ PRIVATE CLASS FUNCTIONS ____________________________________

Private Sub cmbrs_OnUpdate()
    With ActiveWindow.RangeSelection
        If .Parent Is Sh Then
            If IsNull(.Locked) Or .Locked Then
                bExitLoop = False
                Call ProcessMessages(Sh)
            End If
        End If
    End With
End Sub

#If Win64 Then
    Private Function GetHwnds(ByVal Wb As Workbook) As LongLong()
    Dim hTmpArray() As LongLong
#Else
    Private Function GetHwnds(ByVal Wb As Workbook) As Long()
    Dim hTmpArray() As Long
#End If

    Dim oWind As Window
    Dim i As Long
    
    ReDim hTmpArray(Wb.Windows.Count)
    For i = 0 To Wb.Windows.Count - 1
        hTmpArray(i) = Wb.Windows(i + 1).hwnd
    Next i
    GetHwnds = hTmpArray
End Function

Private Function IsWbWindActive() As Boolean
    #If Win64 Then
        Dim hTmpArray() As LongLong
    #Else
        Dim hTmpArray() As Long
    #End If

    hTmpArray = GetHwnds(Wb)
    IsWbWindActive = Not IsError(Application.Match(GetActiveWindow, hTmpArray, 0))
End Function

Private Function IsBackstageView() As Boolean
    IsBackstageView = CBool(FindWindowEx(Application.hwnd, 0, "FullpageUIHost", vbNullString))
End Function

Private Function IsVBEActive() As Boolean
    IsVBEActive = CBool(FindWindow("wndclass_desked_gsk", vbNullString) = GetActiveWindow)
End Function

Private Function IsOk() As Boolean
    Dim bOk As Boolean
    bOk = Sh.ProtectContents
    With Application.ActiveWindow.RangeSelection
        bOk = bOk And (IsNull(.Locked) Or .Locked)
    End With
    bOk = bOk And IsWbWindActive
    bOk = bOk And (ActiveSheet Is Sh)
    bOk = bOk And Not IsVBEActive
    bOk = bOk And Not IsBackstageView
    IsOk = bOk
End Function


2- Code Usage Example [ThisWorkBook Module]
VBA Code:
Option Explicit

Private WithEvents oInstance As clsCustomProtectiontMessage

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Call StartMonitoring
End Sub

Private Sub StartMonitoring()
    If Not oInstance Is Nothing Then
        oInstance.StopProcessing
    End If
    Set oInstance = New clsCustomProtectiontMessage
    Call oInstance.ProcessMessages(WS:=Sheet1) '<<= change target sheet as needed.
End Sub

'________________________________ CUSTOM EVENT _____________________________________
Private Sub oInstance_CustomProtectedSheetWarning()
    MsgBox "This is a custom sheet-protection message.", vbInformation
End Sub

Note: This custom sheet-protection message doesn't work when using drag and drop or autofill... If I have time later on, I will see if I can find a way to also intercept those two commands.

Regards.
 
Upvote 0
The forum is acting funny. I don't know why post#23 was not deleted.

Anyway, just to confirm. please ignore the code in post#23 and use the more complete one in post#25
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,876
Members
452,363
Latest member
merico17

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