Option Explicit
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 UnhookWindowsHookEx _
Lib "user32" (ByVal hHook As Long) 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 Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE = 5
Private lhHook As Long
Private bHookEnabled As Boolean
Private Declare Function GetClassName _
Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () 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 SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Const BM_CLICK = &HF5
'French version
'Const WARNING_MESSAGE1 = _
'"Les feuilles sélectionnées peuvent contenir des données."
'English Version
Const WARNING_MESSAGE2 = _
"The selected sheet(s)will be permanently deleted."
Sub StartEvent()
'install a cbt hook to monitor for the activation of a window
If Not bHookEnabled Then
lhHook = SetWindowsHookEx _
(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
bHookEnabled = True
Else
MsgBox "The Event is already active.", vbInformation
End If
End Sub
Sub TerminateEvent()
'important to unhook when done!
UnhookWindowsHookEx lhHook
bHookEnabled = False
End Sub
Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim sBuffer1 As String
Dim sBuffer2 As String
Dim lRetVal As Long
Dim lhwndText As Long
Dim lhwndDelete As Long
Dim lhwndCancel As Long
Dim bCancel As Boolean
'' On Error Resume Next
'check if a window has been activated.
If idHook = HCBT_ACTIVATE Then
'if so,get it's class name.
sBuffer1 = Space(256)
lRetVal = GetClassName(wParam, sBuffer1, 256)
'if it is a #32770 window that is being activated
'retrieve its text to ensure it's the sh deletion warning window.
If Left(sBuffer1, lRetVal) = "#32770" Then
lhwndText = FindWindowEx(wParam, ByVal 0&, "MSOUNISTAT", vbNullString)
sBuffer2 = Space(256)
GetWindowText lhwndText, sBuffer2, 256
'if it is, get the "Cancel" button hwnd and
'send a BM_CLICK to it before the window gets a chance to appear.
If InStr(1, Left(sBuffer2, Len(sBuffer2) - 1), _
WARNING_MESSAGE2, vbTextCompare) Then
lhwndDelete = FindWindowEx(wParam, 0, "BUTTON", vbNullString)
lhwndCancel = FindWindowEx(wParam, lhwndDelete, "BUTTON", vbNullString)
'call our event and return the "bCancel" argument ByRef
Call thisWorkbook.ThisWorkbook_SheetBeforeDelete _
(ActiveSheet, bCancel)
'if the "bCancel" argument is True- ie: the user set
'the "Cancel" argument in the Event handler to True
'then abort the activation of the warning window.
If VariousSheetsSelected Then _
MsgBox "You may only delete worksheets one at a time.", vbInformation
If bCancel Or VariousSheetsSelected Then
HookProc = 1
Call TerminateEvent
SendMessage lhwndCancel, BM_CLICK, 0, 0
Call StartEvent
End If
End If
End If
End If
Xit:
'Call next hook
HookProc = CallNextHookEx(lhHook, idHook, ByVal wParam, ByVal lParam)
End Function
Private Function VariousSheetsSelected() As Boolean
If ActiveWindow.SelectedSheets.Count > 1 _
Then VariousSheetsSelected = True
End Function
i got this code to work for my version of XL in French. I hope i have made the necessary changes so that it works for English versions too.
