Determinar la pestaña de la cinta actualmente seleccionada

Recientemente me encontré con un hilo en UtterAccess donde un usuario preguntaba cómo se podía identificar la pestaña de la cinta actualmente seleccionada en su aplicación.

Al ver que nadie mordisqueaba decidí dar mi granito de arena.

La solución típica

Mi instinto inicial fue sugerir

Si está implementando su propia cinta y código, es posible detectar cuándo se seleccionan las pestañas y, por lo tanto, podría guardar esta información antes de realizar otras acciones.

Una mejor solución

No me gustó particularmente el enfoque anterior y estaba interesado en encontrar una solución universal que pudiera simplemente insertarse en cualquier aplicación de Office.

Luego recordé que había desarrollado algo de UIAutomation hace un par de años, así que lo desenterré y comencé a jugar. Después de un tiempo, desarrollé una solución:

'---------------------------------------------------------------------------------------
' Procedure : UIA_GetSelectedRibbonTab
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Identify the currently selected ribbon tab
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: UIAutomationClient
' Dependencies: oUIA()
'
' Usage:
' ~~~~~~
' Debug.Print UIA_GetSelectedRibbonTab
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2024-12-12              Initial Release - UA Help
'---------------------------------------------------------------------------------------
Public Function UIA_GetSelectedRibbonTab() As String
    Dim oUIAAccess                          As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementRibbon                   As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementTab                      As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementSelectionItemPattern     As UIAutomationClient.IUIAutomationSelectionItemPattern
    Dim aoUIAElementRibbonChildren          As UIAutomationClient.IUIAutomationElementArray
    Dim lCounter                            As Long

    'Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp) ' Access
    Set oUIAAccess = UIA_Find_DbElement(Application.hWnd)  ' Excel
    If Not (oUIAAccess Is Nothing) Then
        Set oUIAElementRibbon = UIA_FindElement_NameAndClass(oUIAAccess, "Ribbon Tabs", "NetUIPanViewer")
        If Not (oUIAElementRibbon Is Nothing) Then
            Set aoUIAElementRibbonChildren = oUIAElementRibbon.FindAll(TreeScope_Children, oUIA.CreateTrueCondition)
            For lCounter = 0 To aoUIAElementRibbonChildren.Length - 1
                If aoUIAElementRibbonChildren.GetElement(lCounter).CurrentClassName = "NetUIRibbonTab" Then
                    Set oUIAElementTab = aoUIAElementRibbonChildren.GetElement(lCounter)
                    If Not (oUIAElementTab Is Nothing) Then
                        Set oUIAElementSelectionItemPattern = oUIAElementTab.GetCurrentPattern(UIA_SelectionItemPatternId)
                        If oUIAElementSelectionItemPattern.CurrentIsSelected = 1 Then
                            UIA_GetSelectedRibbonTab = oUIAElementTab.CurrentName
                            Exit For
                        End If
                    End If
                End If
            Next
        End If
    End If
End Function

Código de ayuda

Private pUIA As UIAutomationClient.CUIAutomation '.IUIAutomation6 .IUIAutomation

Public Function oUIA() As UIAutomationClient.CUIAutomation '.IUIAutomation6 .IUIAutomation
    If pUIA Is Nothing Then
        Set pUIA = New UIAutomationClient.CUIAutomation
    End If
    Set oUIA = pUIA
End Function

'---------------------------------------------------------------------------------------
' Procedure : UIA_Find_DbElement
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Use to return the IUIAutomationElement of the HWND
'               For our purposes the current database
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: UIAutomationClient
' Dependencies: oUIA()
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' Hwnd      : The HWND of the element we want to bind to
'
' Usage:
' ~~~~~~
' Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2022-07-06              Dev
' 2         2022-10-22              Initial Release
'---------------------------------------------------------------------------------------
Public Function UIA_Find_DbElement(ByVal hWnd As Long) As UIAutomationClient.IUIAutomationElement
On Error GoTo Error_Handler
'    Dim oUIA                 As UIAutomationClient.CUIAutomation '.IUIAutomation6 .IUIAutomation
'
'    Set oUIA = New UIAutomationClient.CUIAutomation
    Set UIA_Find_DbElement = oUIA.ElementFromHandle(ByVal hWnd)

Error_Handler_Exit:
    On Error Resume Next
'    Set oUIA = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: UIA_Find_DbElement" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : UIA_FindElement_NameAndClass
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Retrieve the matching element name with the specified class in the subtree
'               of the passed element
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: UIAutomationClient
' Dependencies: oUIA()
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' Application   : Element to search the subtree of
' sName         : Name of the element being searched for
' sClass        : Name of the Class to match
'
' Usage:
' ~~~~~~
' Set oUIAElement = UIA_FindElement_NameAndClass(UIA_Find_DbElement(Application.hWndAccessApp), _
'                                                "Clear Search String", "NetUINavPaneGroup")
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2022-10-25              Initial Release
'---------------------------------------------------------------------------------------
Public Function UIA_FindElement_NameAndClass(ByRef oUIAStartElement As UIAutomationClient.IUIAutomationElement, _
                                             ByVal sName As String, _
                                             ByVal sClass As String) As UIAutomationClient.IUIAutomationElement
    Dim oUIA                  As UIAutomationClient.CUIAutomation
    Dim oUIACondition         As UIAutomationClient.IUIAutomationCondition
    Dim oUIAElement           As UIAutomationClient.IUIAutomationElement

    Set oUIA = New CUIAutomation
    Set oUIACondition = oUIA.CreateAndCondition(oUIA.CreatePropertyCondition(UIA_NamePropertyId, sName), _
                                                oUIA.CreatePropertyCondition(UIA_ClassNamePropertyId, sClass))
    Set oUIAElement = oUIAStartElement.FindFirst(TreeScope_Subtree, oUIACondition)

    Set UIA_FindElement_NameAndClass = oUIAElement

    Set oUIAElement = Nothing
    Set oUIACondition = Nothing
    Set oUIA = Nothing
End Function

Es importante tener en cuenta que para que este código funcione, primero debe agregar una referencia de VBA a ‘UIAutomationClient’.

¿Cómo funciona exactamente?

Es bastante sencillo, aunque el código pueda parecer desalentador.

Primero, vinculamos la instancia UIAutomation de nuestra aplicación, en nuestro caso Microsoft Access usando su HWND:

Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)

Luego, encuentro el elemento Ribbon UIAutomation:

Set oUIAElementRibbon = UIA_FindElement_NameAndClass(oUIAAccess, "Ribbon Tabs", "NetUIPanViewer")

Ahora que tenemos la cinta con la que trabajar, buscamos e iteramos sobre sus elementos secundarios:

Set aoUIAElementRibbonChildren = oUIAElementRibbon.FindAll(TreeScope_Children, oUIA.CreateTrueCondition)
For lCounter = 0 To aoUIAElementRibbonChildren.Length - 1
'...
Next

Debido a la forma en que se crea la Cinta a partir de diferentes tipos de elementos, en la iteración, limito específicamente la búsqueda a pestañas, aquellas con una clase de ‘NetUIRibbonTab’:

If aoUIAElementRibbonChildren.GetElement(lCounter).CurrentClassName = "NetUIRibbonTab" Then
'...
End If

Si hemos llegado hasta ahora en el proceso, entonces el elemento con el que estamos tratando es una pestaña de cinta, por lo que configuro oUIAElementTab en el elemento iterado actual (para que podamos seguir trabajando con él):

Set oUIAElementTab = aoUIAElementRibbonChildren.GetElement(lCounter)

Por último, creamos una variable de patrón UIAutomation para que finalmente podamos verificar el valor CurrentIsSelected de la pestaña (0 => no está seleccionado, 1 => seleccionado)

Set oUIAElementSelectionItemPattern = oUIAElementTab.GetCurrentPattern(UIA_SelectionItemPatternId)
    If oUIAElementSelectionItemPattern.CurrentIsSelected = 1 Then
        UIA_GetSelectedRibbonTab = oUIAElementTab.CurrentName
        Exit For
    End If

Este fue un viaje emocionante ya que revisé algunos conceptos que exploré hace un par de años y los adapté para crear algo completamente nuevo, algo que nunca había visto antes y ciertamente nunca lo había intentado. Continuamente me sorprende lo que podemos lograr con VBA, impulsados ​​por nuestra determinación de persistir y experimentar con nuevas ideas.