Option Explicit
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
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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=If]#If[/URL] Win64 Then
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
[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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare 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 Const CHILDID_SELF = &H0&
Private bXitLoop As Boolean
[COLOR=#008000]'*************************************************************[/COLOR]
[COLOR=#008000]' This is the generic label On_Click pseudo-event.[/COLOR] [COLOR=#008000]'*[/COLOR]
Private Sub GenericLabelClickEvent(ByVal Label As Control) [COLOR=#008000]'*[/COLOR]
MsgBox "You clicked Label : '" & Label.Name & "'" [COLOR=#008000]'*[/COLOR]
End Sub [COLOR=#008000]'*[/COLOR]
[COLOR=#008000]'************************************************************[/COLOR]
Private Sub UserForm_Activate()
[COLOR=#008000] 'run any pre-existing form activation code here before starting the loop.[/COLOR]
Call StartLoop
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
bXitLoop = True
End Sub
Private Sub StartLoop()
Dim tCurPos As POINTAPI
Dim oIA As IAccessible
Dim vKid As Variant
Dim Ctl As Control
Dim ArLabels() As Control
Dim ArLabelCaptions() As String
Dim iLabelsCount As Integer
For Each Ctl In Me.Controls
If TypeName(Ctl) = "Label" Then
ReDim Preserve ArLabels(iLabelsCount)
ReDim Preserve ArLabelCaptions(iLabelsCount)
Set ArLabels(iLabelsCount) = Ctl
ArLabelCaptions(iLabelsCount) = Ctl.Caption
iLabelsCount = iLabelsCount + 1
End If
Next Ctl
If iLabelsCount Then
Do
GetCursorPos tCurPos
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] Win64 Then
Dim Ptr As LongPtr
CopyMemory Ptr, tCurPos, LenB(tCurPos)
Call AccessibleObjectFromPoint(Ptr, oIA, vKid)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, oIA, vKid)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
If Not IsError(Application.Match(oIA.accName(CHILDID_SELF), ArLabelCaptions, 0)) Then
If GetKeyState(vbKeyLButton) = -127 Or GetKeyState(vbKeyLButton) = -128 Then
Call GenericLabelClickEvent(ArLabels(Application.Match(oIA.accName(CHILDID_SELF), ArLabelCaptions, 0) - 1))
End If
End If
DoEvents
Loop Until bXitLoop
End If
End Sub
