Option Explicit
Private WithEvents cmbrs As CommandBars
Private Type POINTAPI
x As Long
Y As Long
End Type
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] Win64 Then
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal arg1 As LongPtr, ppacc As IAccessible, pvarChild As Variant) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () 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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal Hwnd As LongPtr) As Long
Private Hwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetActiveWindow Lib "user32" () 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 Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function IsWindowVisible Lib "user32" (ByVal Hwnd As Long) As Long
Private Hwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Const CHILDID_SELF = &H0&
Private Const S_OK As Long = &H0
[B][COLOR=#006400]'***************************************************************
'* Pseudo-Event *
'***************************************************************[/COLOR][/B]
Private Sub Pseudo_Worksheet_BeforeDelete_Event(ByVal Selected_Sheets As Sheets, ByRef Cancel As Boolean)
Dim vArray As Variant
Dim oSh As Object
vArray = Array("Training Spreadsheet", "Training List", "Report Options", "Data-do not delete")
For Each oSh In Selected_Sheets
If Not IsError(Application.Match(oSh.Name, vArray, 0)) Then
Cancel = True
MsgBox "Can't delete the sheet :- '" & oSh.Name & "'", vbCritical
Exit Sub
End If
Next
End Sub
[B][COLOR=#006400]'*****************************************************************[/COLOR][/B]
Private Sub Workbook_Open()
Set cmbrs = Application.CommandBars
Call cmbrs_OnUpdate
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Set cmbrs = Application.CommandBars
Call cmbrs_OnUpdate
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set cmbrs = Nothing
End Sub
Private Sub cmbrs_OnUpdate()
Dim sArray() As String
Dim sBuf As String * 256
Dim lRes As Long, i As Long
Dim bCancelDelete As Boolean
If Not ActiveWorkbook Is Me Then Exit Sub
Application.CommandBars.FindControl(ID:=2020).Enabled = Not Application.CommandBars.FindControl(ID:=2020).Enabled
lRes = GetClassName(GetActiveWindow, sBuf, 256)
[COLOR=#006400] 'If Left(sBuf, lRes) = "wndclass_desked_gsk" Then Set cmbrs = Nothing: Exit Sub '<== Optional line.[/COLOR]
If Left(sBuf, lRes) = "Net UI Tool Window" Then
For i = 0 To Me.Worksheets.Count - 1
ReDim Preserve sArray(i)
sArray(i) = Me.Worksheets(i + 1).Name
Next
If Not IsError(Application.Match(GetAccUnderMouse, sArray, 0)) Then
Hwnd = GetActiveWindow
Do
If Replace(Application.CommandBars.FindControl(ID:=5858).Caption, "&", "") = GetAccUnderMouse Then
If GetAsyncKeyState(VBA.vbKeyLButton) < 0 Then
Call Pseudo_Worksheet_BeforeDelete_Event(ActiveWindow.SelectedSheets, bCancelDelete)
If Not bCancelDelete Then ActiveWindow.SelectedSheets.Delete
End If
End If
DoEvents
Loop Until IsWindowVisible(Hwnd) = 0
End If
End If
End Sub
Private Function GetAccUnderMouse() As String
Dim tPt As POINTAPI, oIA As IAccessible, lRes As Long
GetCursorPos tPt
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] Win64 Then
Dim lngPtr As LongPtr
CopyMemory lngPtr, tPt, LenB(tPt)
lRes = AccessibleObjectFromPoint(lngPtr, oIA, 0)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
lRes = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, 0)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
If lRes = S_OK Then GetAccUnderMouse = oIA.accName(CHILDID_SELF)
End Function
