Execute a button from third party com add-In

A

abc_xyz

New Member
Joined
Jan 12, 2022
Messages
47
Office Version
  1. 2016
Platform
  1. Windows
I have installed a third party com add-in. It is a .vsto file format. The add-in has a Refresh All button. I want to execute that using VBA.
Is this even possible?
 
Sort by date Sort by votes
Just found this generic recursive method that was posted in this forum long time ago by Rory

www.mrexcel.com

oBar.Controls("Hyperion").Controls("Refresh All").Execute

Hi, I used such a code which worked with Excell 2003 with not problems: Sub refr() Dim oBar As CommandBar Set oBar = Application.CommandBars("Worksheet Menu Bar") oBar.Controls("Hyperion").Controls("Refresh All").Execute End Sub but sometime ago our IT dep updated Smart View in Hyperion...
www.mrexcel.com www.mrexcel.com

You should call it like this :
VBA Code: 
Sub Click_RefreshAll()
    ClickCustomButton "Dealogic", "Refresh", "Refresh All"
End Sub
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Jaafar Tribak said:
Just found this generic recursive method that was posted in this forum long time ago by Rory

www.mrexcel.com

oBar.Controls("Hyperion").Controls("Refresh All").Execute

Hi, I used such a code which worked with Excell 2003 with not problems: Sub refr() Dim oBar As CommandBar Set oBar = Application.CommandBars("Worksheet Menu Bar") oBar.Controls("Hyperion").Controls("Refresh All").Execute End Sub but sometime ago our IT dep updated Smart View in Hyperion...
www.mrexcel.com www.mrexcel.com

You should call it like this :
VBA Code: 
Sub Click_RefreshAll()
    ClickCustomButton "Dealogic", "Refresh", "Refresh All"
End Sub
Click to expand...
I did give it a try but it does not work. Code must be updated for use of 64-bit systems is shown by highlighting the below code in red. Am I missing something? Do I need to enable any library from the reference window?

VBA Code: 
Private Declare Function AccessibleChildren _
                Lib "oleacc.dll" _
                    (ByVal paccContainer As Object, _
                     ByVal iChildStart As Long, _
                     ByVal cChildren As Long, _
                           rgvarChildren As Variant, _
                           pcObtained As Long) _
                As Long

Private Declare Function GetRoleText _
                Lib "oleacc.dll" _
                Alias "GetRoleTextA" _
                    (ByVal dwRole As Long, _
                           lpszRole As Any, _
                     ByVal cchRoleMax As Long) _
                As Long
 
Upvote 0
Here is the same code with declarations for x32 and x64

VBA Code: 
Option Explicit
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Definitions and Procedures relating to Accessibility, used by the Ribbon VBA  '
' Demonstration UserForm. The constants have been lifted from oleacc.h, and are '
' just a subset of those available.                                             '
'                                                                               '
'                                                    Tony Jollans, August 2008. '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

Public Const CHILDID_SELF                  As Long = &H0&

Private Const STATE_SYSTEM_UNAVAILABLE     As Long = &H1&
Private Const STATE_SYSTEM_INVISIBLE       As Long = &H8000&
Private Const STATE_SYSTEM_SELECTED        As Long = &H2&

Public Enum RoleNumber
    ROLE_SYSTEM_CLIENT = &HA&
    ROLE_SYSTEM_PANE = &H10&
    ROLE_SYSTEM_GROUPING = &H14&
    ROLE_SYSTEM_TOOLBAR = &H16&
    ROLE_SYSTEM_PROPERTYPAGE = &H26&
    ROLE_SYSTEM_GRAPHIC = &H28&
    ROLE_SYSTEM_STATICTEXT = &H29&
    ROLE_SYSTEM_Text = &H2A&
    ROLE_SYSTEM_PAGETABLIST = &H3C&
End Enum

Private Enum NavigationDirection
    NAVDIR_FIRSTCHILD = &H7&
End Enum

#If VBA7 Then
    Private Declare PtrSafe Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, ByVal cChildren As Long, rgvarChildren As Variant, pcObtained As Long) As Long
    Private Declare PtrSafe Function GetRoleText Lib "oleacc.dll" Alias "GetRoleTextA" (ByVal dwRole As Long, lpszRole As Any, ByVal cchRoleMax As Long) As Long
#Else
    Private Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, ByVal cChildren As Long, rgvarChildren As Variant, pcObtained As Long) As Long
    Private Declare Function GetRoleText Lib "oleacc.dll" Alias "GetRoleTextA" (ByVal dwRole As Long, lpszRole As Any, ByVal cchRoleMax As Long) As Long
#End If


Public Type ChildList
    Objects()       As IAccessible
    Levels()        As Long
    SelectedIndex   As Long
End Type

Dim RibbonPropPage           As IAccessible
Dim ActiveTabPropPage       As IAccessible

Dim TabInfo                 As ChildList
Dim GroupInfo               As ChildList
Dim ItemInfo                As ChildList

Dim Initialised             As Boolean


Public Sub ClickCustomButton(strTab As String, strGroup As String, strCaption As String)
    Dim TabName As String
    Dim RibbonPaneClient As IAccessible
    Dim ndx As Long
    Dim RibbonTab As IAccessible
    Dim PageTabListClient As IAccessible
    Dim GroupToolBar As IAccessible

    Dim NamesAndRoles() As Variant

    Dim DefaultAction As String
    Dim n As Long
    Dim j As Long
    Set RibbonPropPage = GetAccessible(Application.CommandBars("Ribbon"), _
                                       ROLE_SYSTEM_PROPERTYPAGE, _
                                       "Ribbon")
    Set PageTabListClient = GetAccessible(RibbonPropPage, _
                                          ROLE_SYSTEM_PAGETABLIST, _
                                          "Ribbon Tabs", _
                                          True)

    TabInfo = GetListOfChildren(PageTabListClient)

    NamesAndRoles = NameAndRoleText(TabInfo)
    For n = LBound(NamesAndRoles(0)) To UBound(NamesAndRoles(0))
        If StrComp(NamesAndRoles(0)(n), strTab, vbTextCompare) = 0 Then

            Set RibbonTab = TabInfo.Objects(n)

            Set RibbonPaneClient = GetAccessible(RibbonPropPage, _
                                                 ROLE_SYSTEM_PANE, _
                                                 "Lower Ribbon", _
                                                 True)
            Set ActiveTabPropPage = GetAccessible(RibbonPaneClient, _
                                                  ROLE_SYSTEM_PROPERTYPAGE, _
                                                  RibbonTab.accName(CHILDID_SELF))

            GroupInfo = GetListOfChildren(ActiveTabPropPage, GetDescendents:=False)

            NamesAndRoles = NameAndRoleText(GroupInfo)
            For j = LBound(NamesAndRoles(0)) To UBound(NamesAndRoles(0))
                If StrComp(NamesAndRoles(0)(j), strGroup, vbTextCompare) = 0 Then

                    Set GroupToolBar = GetAccessible(ActiveTabPropPage, _
                                                     ROLE_SYSTEM_TOOLBAR, _
                                                     GroupInfo.Objects(j) _
                                                     .accName(CHILDID_SELF))

                    ItemInfo = GetListOfChildren(GroupToolBar)

                    NamesAndRoles = NameAndRoleText(ItemInfo, _
                                                    IncludeRoleText:=True)

                    For ndx = LBound(NamesAndRoles(0)) To UBound(NamesAndRoles(0))
                        If StrComp(NamesAndRoles(0)(ndx), strCaption, vbTextCompare) = 0 Then
                            ItemInfo.Objects(ndx).accDoDefaultAction CHILDID_SELF

                            Exit Sub
                        End If


                    Next ndx
                    Exit Sub
                End If
            Next j
            Exit Sub
        End If
    Next n

End Sub
Public Function GetAccessible _
                    (Element As IAccessible, _
                     RoleWanted As RoleNumber, _
                     NameWanted As String, _
                     Optional GetClient As Boolean) _
                As IAccessible

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' This procedure recursively searches the accessibility hierarchy, starting '
    ' with the element given, for an object matching the given name and role.   '
    ' If requested, the Client object, assumed to be the first child, will be   '
    ' returned instead of its parent.                                           '
    '                                                                           '
    ' Calls: GetChildren to, well, get children.                                '
    '        Itself, recursively, to move down the hierarchy                    '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim ChildrenArray()
    Dim Child               As IAccessible
    Dim ndxChild            As Long
    Dim ReturnElement       As IAccessible
    
    If Element.accRole(CHILDID_SELF) = RoleWanted _
    And Element.accName(CHILDID_SELF) = NameWanted Then

        Set ReturnElement = Element
        
    Else ' not found yet
    
        ChildrenArray = GetChildren(Element)
        
        If (Not ChildrenArray) <> True Then
            
            For ndxChild = LBound(ChildrenArray) To UBound(ChildrenArray)
                
                If TypeOf ChildrenArray(ndxChild) Is IAccessible Then
                
                    Set Child = ChildrenArray(ndxChild)
                    Set ReturnElement = GetAccessible(Child, _
                                                      RoleWanted, _
                                                      NameWanted)
                    If Not ReturnElement Is Nothing Then Exit For
                
                End If ' Child is IAccessible
            
            Next ndxChild
        
        End If ' there are children
    
    End If ' still looking

    If GetClient Then
        Set ReturnElement = ReturnElement.accNavigate(NAVDIR_FIRSTCHILD, _
                                                      CHILDID_SELF)
    End If
    
    Set GetAccessible = ReturnElement
    
End Function


Public Function GetListOfChildren _
                        (Parent As IAccessible, _
                     Optional GetDescendents As Boolean = True) _
                As ChildList

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Given a parent IAccessible object, will return a (UDT ChildList) array of '
    ' its children. Each returned object will be the bottom one of a leg in the '
    ' Accessibility hierarchy, unless told not to look at children's children.  '
    '                                                                           '
    ' Calls: AddChildToList to populate the return array                        '
    '        Itself, recursively, to process descendents                        '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim ChildInfo               As ChildList
    Dim ndxChild                As Long
    Dim Child                   As IAccessible

    Dim LocalChildren()         As Variant
    Dim LocalAncestry()         As IAccessible

    Dim GrandChildInfo          As ChildList
    Dim ndxGrandChild           As Long
    Dim GrandChild              As IAccessible

    LocalChildren = GetChildren(Parent)

    If (Not LocalChildren) <> True Then

        For ndxChild = LBound(LocalChildren) To UBound(LocalChildren)

            Set Child = LocalChildren(ndxChild)

            If Child.accRole(CHILDID_SELF) <> ROLE_SYSTEM_GRAPHIC _
            And Child.accRole(CHILDID_SELF) <> ROLE_SYSTEM_STATICTEXT Then

                If ((Child.accState(CHILDID_SELF) _
                    And (STATE_SYSTEM_UNAVAILABLE _
                         Or STATE_SYSTEM_INVISIBLE)) = 0) Then

                    If Child.accChildCount = 0 _
                    Or GetDescendents = False Then

                        AddChildToList Child, ChildInfo

                    Else

                        GrandChildInfo = GetListOfChildren(Child)

                        If (Not GrandChildInfo.Objects) <> True Then

                            For ndxGrandChild = LBound(GrandChildInfo.Objects) _
                                                To UBound(GrandChildInfo.Objects)

                                Set GrandChild _
                                    = GrandChildInfo.Objects(ndxGrandChild)

                                AddChildToList GrandChild, ChildInfo
                                ChildInfo.Levels(UBound(ChildInfo.Objects)) _
                                    = GrandChildInfo.Levels(ndxGrandChild) + 1

                            Next ndxGrandChild

                        End If ' Any grandchildren found?

                    End If ' Check for grandchildren?

                End If ' Not unavailable

            End If ' Not (graphic or text)

        Next ndxChild

    End If ' Any children?

    GetListOfChildren = ChildInfo

End Function


Private Sub AddChildToList _
                (Child As IAccessible, _
                 ChildInfo As ChildList)

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Adds an array entry and fills it with the passed IAccessible object. If   '
    ' the object is the currently selected one, the fact is recorded.           '
    '                                                                           '
    ' Called by: GetListOfChildren                                              '
    ' Calls: Nothing                                                            '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    With ChildInfo

        If (Not .Objects) = True Then
            ReDim .Objects(0 To 0)
            ReDim .Levels(LBound(.Objects) To UBound(.Objects))
        Else
            ReDim Preserve .Objects(LBound(.Objects) To UBound(.Objects) + 1)
            ReDim Preserve .Levels(LBound(.Objects) To UBound(.Objects))
        End If

        Set .Objects(UBound(.Objects)) = Child

        If ((Child.accState(CHILDID_SELF) And (STATE_SYSTEM_SELECTED)) _
                                             = STATE_SYSTEM_SELECTED) Then
            .SelectedIndex = UBound(.Objects)
        End If

    End With ' ChildInfo

End Sub

Private Function GetChildren _
                     (Element As IAccessible) _
                 As Variant()

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' General purpose subroutine to get an array of children of an IAccessible  '
    ' object. The returned array is Variant because the elements may be either  '
    ' IAccessible objects or simple (Long) elements, and the caller must treat  '
    ' them appropriately.                                                       '
    '                                                                           '
    ' Called by: GetAccessible when searching for an Accessible element         '
    '            GetListOfChildren when retrieving a list of children           '
    ' Calls: AccessibleChildren API                                             '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Const FirstChild        As Long = 0&

    Dim NumChildren         As Long
    Dim NumReturned         As Long

    Dim ChildrenArray()

    NumChildren = Element.accChildCount

    If NumChildren > 0 Then

        ReDim ChildrenArray(NumChildren - 1)
        AccessibleChildren Element, FirstChild, NumChildren, _
                           ChildrenArray(0), NumReturned

    End If

    GetChildren = ChildrenArray

End Function

Public Function RoleText _
                    (Role As RoleNumber) _
                As String

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Just a wrapper for the GetRoleText API.                                   '
    '                                                                           '
    ' Calls: GetRoleText API - once to get the length and once to get the text. '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim RoleTemp        As String
    Dim RoleTextLength  As Long
    Dim RoleChar()      As Byte
    Dim ndxRoleChar     As Long

    RoleTextLength = GetRoleText(Role, ByVal 0, 0&)
    ReDim RoleChar(0 To RoleTextLength)
    GetRoleText Role, RoleChar(LBound(RoleChar)), RoleTextLength + 1

    For ndxRoleChar = LBound(RoleChar) To UBound(RoleChar) - 1
        RoleTemp = RoleTemp & Chr(RoleChar(ndxRoleChar))
    Next ndxRoleChar

    RoleText = RoleTemp

End Function
Private Function NameAndRoleText _
                      (Info As ChildList, _
                      Optional IncludeRoleText As Boolean = False) _
                 As Variant()

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Builds compound object names and role texts from an IAccessible object    '
    ' and its ancestors up to the appropriate level, as previously determined.  '
    ' The ancestors have not been stored, so are collected here into a simple   '
    ' array before building up the strings.                                     '
    '                                                                           '
    ' Calls: AppendToString to append text, if non-duplicate, and a separator,  '
    '                       if necessary, to a name or role string.             '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim ReturnArray(0 To 1)

    Dim NamesArray()    As String
    Dim RolesArray()    As String

    ReDim NamesArray(LBound(Info.Objects) To UBound(Info.Objects))

    If IncludeRoleText Then
        ReDim RolesArray(LBound(Info.Objects) To UBound(Info.Objects))
    End If

    Dim Ancestry()      As IAccessible
    Dim AncestralName   As String
    Dim ndxObject       As Long
    Dim ndxAncestry     As Long

    For ndxObject = LBound(Info.Objects) To UBound(Info.Objects)

        ReDim Ancestry(0 To Info.Levels(ndxObject))

        Set Ancestry(LBound(Ancestry)) = Info.Objects(ndxObject)
        For ndxAncestry = LBound(Ancestry) + 1 To UBound(Ancestry)
            Set Ancestry(ndxAncestry) = Ancestry(ndxAncestry - 1).accParent
        Next ndxAncestry

        For ndxAncestry = UBound(Ancestry) To LBound(Ancestry) Step -1

            AncestralName = ""
            If ndxAncestry < UBound(Ancestry) Then
                AncestralName = Ancestry(ndxAncestry + 1).accName(CHILDID_SELF)
            End If

            If Ancestry(ndxAncestry).accName(CHILDID_SELF) _
                    <> AncestralName Then

                AppendToString NamesArray(ndxObject), _
                               Ancestry(ndxAncestry).accName(CHILDID_SELF)

            End If

            If IncludeRoleText Then
                If Ancestry(ndxAncestry).accRole(CHILDID_SELF) _
                        <> ROLE_SYSTEM_GROUPING Then

                    AppendToString RolesArray(ndxObject), _
                                   RoleText(Ancestry(ndxAncestry) _
                                            .accRole(CHILDID_SELF))

                End If
            End If

        Next ndxAncestry

    Next ndxObject

    NameAndRoleText = Array(NamesArray(), RolesArray())

End Function

Private Sub AppendToString(NameOrRole As String, Appendix As String)

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Called from NameAndRoleText (q.v., above) to append appropriate text to a '
    ' name or role string.                                                      '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Const TextSeparator As String = " - "

    If NameOrRole <> "" Then
        If Right(NameOrRole, Len(TextSeparator)) <> TextSeparator Then

            NameOrRole = NameOrRole & TextSeparator

        End If
    End If

    NameOrRole = NameOrRole & Appendix

End Sub
 
Upvote 0
Jaafar Tribak said:
Here is the same code with declarations for x32 and x64

VBA Code: 
Option Explicit
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Definitions and Procedures relating to Accessibility, used by the Ribbon VBA  '
' Demonstration UserForm. The constants have been lifted from oleacc.h, and are '
' just a subset of those available.                                             '
'                                                                               '
'                                                    Tony Jollans, August 2008. '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

Public Const CHILDID_SELF                  As Long = &H0&

Private Const STATE_SYSTEM_UNAVAILABLE     As Long = &H1&
Private Const STATE_SYSTEM_INVISIBLE       As Long = &H8000&
Private Const STATE_SYSTEM_SELECTED        As Long = &H2&

Public Enum RoleNumber
    ROLE_SYSTEM_CLIENT = &HA&
    ROLE_SYSTEM_PANE = &H10&
    ROLE_SYSTEM_GROUPING = &H14&
    ROLE_SYSTEM_TOOLBAR = &H16&
    ROLE_SYSTEM_PROPERTYPAGE = &H26&
    ROLE_SYSTEM_GRAPHIC = &H28&
    ROLE_SYSTEM_STATICTEXT = &H29&
    ROLE_SYSTEM_Text = &H2A&
    ROLE_SYSTEM_PAGETABLIST = &H3C&
End Enum

Private Enum NavigationDirection
    NAVDIR_FIRSTCHILD = &H7&
End Enum

#If VBA7 Then
    Private Declare PtrSafe Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, ByVal cChildren As Long, rgvarChildren As Variant, pcObtained As Long) As Long
    Private Declare PtrSafe Function GetRoleText Lib "oleacc.dll" Alias "GetRoleTextA" (ByVal dwRole As Long, lpszRole As Any, ByVal cchRoleMax As Long) As Long
#Else
    Private Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, ByVal cChildren As Long, rgvarChildren As Variant, pcObtained As Long) As Long
    Private Declare Function GetRoleText Lib "oleacc.dll" Alias "GetRoleTextA" (ByVal dwRole As Long, lpszRole As Any, ByVal cchRoleMax As Long) As Long
#End If


Public Type ChildList
    Objects()       As IAccessible
    Levels()        As Long
    SelectedIndex   As Long
End Type

Dim RibbonPropPage           As IAccessible
Dim ActiveTabPropPage       As IAccessible

Dim TabInfo                 As ChildList
Dim GroupInfo               As ChildList
Dim ItemInfo                As ChildList

Dim Initialised             As Boolean


Public Sub ClickCustomButton(strTab As String, strGroup As String, strCaption As String)
    Dim TabName As String
    Dim RibbonPaneClient As IAccessible
    Dim ndx As Long
    Dim RibbonTab As IAccessible
    Dim PageTabListClient As IAccessible
    Dim GroupToolBar As IAccessible

    Dim NamesAndRoles() As Variant

    Dim DefaultAction As String
    Dim n As Long
    Dim j As Long
    Set RibbonPropPage = GetAccessible(Application.CommandBars("Ribbon"), _
                                       ROLE_SYSTEM_PROPERTYPAGE, _
                                       "Ribbon")
    Set PageTabListClient = GetAccessible(RibbonPropPage, _
                                          ROLE_SYSTEM_PAGETABLIST, _
                                          "Ribbon Tabs", _
                                          True)

    TabInfo = GetListOfChildren(PageTabListClient)

    NamesAndRoles = NameAndRoleText(TabInfo)
    For n = LBound(NamesAndRoles(0)) To UBound(NamesAndRoles(0))
        If StrComp(NamesAndRoles(0)(n), strTab, vbTextCompare) = 0 Then

            Set RibbonTab = TabInfo.Objects(n)

            Set RibbonPaneClient = GetAccessible(RibbonPropPage, _
                                                 ROLE_SYSTEM_PANE, _
                                                 "Lower Ribbon", _
                                                 True)
            Set ActiveTabPropPage = GetAccessible(RibbonPaneClient, _
                                                  ROLE_SYSTEM_PROPERTYPAGE, _
                                                  RibbonTab.accName(CHILDID_SELF))

            GroupInfo = GetListOfChildren(ActiveTabPropPage, GetDescendents:=False)

            NamesAndRoles = NameAndRoleText(GroupInfo)
            For j = LBound(NamesAndRoles(0)) To UBound(NamesAndRoles(0))
                If StrComp(NamesAndRoles(0)(j), strGroup, vbTextCompare) = 0 Then

                    Set GroupToolBar = GetAccessible(ActiveTabPropPage, _
                                                     ROLE_SYSTEM_TOOLBAR, _
                                                     GroupInfo.Objects(j) _
                                                     .accName(CHILDID_SELF))

                    ItemInfo = GetListOfChildren(GroupToolBar)

                    NamesAndRoles = NameAndRoleText(ItemInfo, _
                                                    IncludeRoleText:=True)

                    For ndx = LBound(NamesAndRoles(0)) To UBound(NamesAndRoles(0))
                        If StrComp(NamesAndRoles(0)(ndx), strCaption, vbTextCompare) = 0 Then
                            ItemInfo.Objects(ndx).accDoDefaultAction CHILDID_SELF

                            Exit Sub
                        End If


                    Next ndx
                    Exit Sub
                End If
            Next j
            Exit Sub
        End If
    Next n

End Sub
Public Function GetAccessible _
                    (Element As IAccessible, _
                     RoleWanted As RoleNumber, _
                     NameWanted As String, _
                     Optional GetClient As Boolean) _
                As IAccessible

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' This procedure recursively searches the accessibility hierarchy, starting '
    ' with the element given, for an object matching the given name and role.   '
    ' If requested, the Client object, assumed to be the first child, will be   '
    ' returned instead of its parent.                                           '
    '                                                                           '
    ' Calls: GetChildren to, well, get children.                                '
    '        Itself, recursively, to move down the hierarchy                    '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim ChildrenArray()
    Dim Child               As IAccessible
    Dim ndxChild            As Long
    Dim ReturnElement       As IAccessible
   
    If Element.accRole(CHILDID_SELF) = RoleWanted _
    And Element.accName(CHILDID_SELF) = NameWanted Then

        Set ReturnElement = Element
       
    Else ' not found yet
   
        ChildrenArray = GetChildren(Element)
       
        If (Not ChildrenArray) <> True Then
           
            For ndxChild = LBound(ChildrenArray) To UBound(ChildrenArray)
               
                If TypeOf ChildrenArray(ndxChild) Is IAccessible Then
               
                    Set Child = ChildrenArray(ndxChild)
                    Set ReturnElement = GetAccessible(Child, _
                                                      RoleWanted, _
                                                      NameWanted)
                    If Not ReturnElement Is Nothing Then Exit For
               
                End If ' Child is IAccessible
           
            Next ndxChild
       
        End If ' there are children
   
    End If ' still looking

    If GetClient Then
        Set ReturnElement = ReturnElement.accNavigate(NAVDIR_FIRSTCHILD, _
                                                      CHILDID_SELF)
    End If
   
    Set GetAccessible = ReturnElement
   
End Function


Public Function GetListOfChildren _
                        (Parent As IAccessible, _
                     Optional GetDescendents As Boolean = True) _
                As ChildList

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Given a parent IAccessible object, will return a (UDT ChildList) array of '
    ' its children. Each returned object will be the bottom one of a leg in the '
    ' Accessibility hierarchy, unless told not to look at children's children.  '
    '                                                                           '
    ' Calls: AddChildToList to populate the return array                        '
    '        Itself, recursively, to process descendents                        '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim ChildInfo               As ChildList
    Dim ndxChild                As Long
    Dim Child                   As IAccessible

    Dim LocalChildren()         As Variant
    Dim LocalAncestry()         As IAccessible

    Dim GrandChildInfo          As ChildList
    Dim ndxGrandChild           As Long
    Dim GrandChild              As IAccessible

    LocalChildren = GetChildren(Parent)

    If (Not LocalChildren) <> True Then

        For ndxChild = LBound(LocalChildren) To UBound(LocalChildren)

            Set Child = LocalChildren(ndxChild)

            If Child.accRole(CHILDID_SELF) <> ROLE_SYSTEM_GRAPHIC _
            And Child.accRole(CHILDID_SELF) <> ROLE_SYSTEM_STATICTEXT Then

                If ((Child.accState(CHILDID_SELF) _
                    And (STATE_SYSTEM_UNAVAILABLE _
                         Or STATE_SYSTEM_INVISIBLE)) = 0) Then

                    If Child.accChildCount = 0 _
                    Or GetDescendents = False Then

                        AddChildToList Child, ChildInfo

                    Else

                        GrandChildInfo = GetListOfChildren(Child)

                        If (Not GrandChildInfo.Objects) <> True Then

                            For ndxGrandChild = LBound(GrandChildInfo.Objects) _
                                                To UBound(GrandChildInfo.Objects)

                                Set GrandChild _
                                    = GrandChildInfo.Objects(ndxGrandChild)

                                AddChildToList GrandChild, ChildInfo
                                ChildInfo.Levels(UBound(ChildInfo.Objects)) _
                                    = GrandChildInfo.Levels(ndxGrandChild) + 1

                            Next ndxGrandChild

                        End If ' Any grandchildren found?

                    End If ' Check for grandchildren?

                End If ' Not unavailable

            End If ' Not (graphic or text)

        Next ndxChild

    End If ' Any children?

    GetListOfChildren = ChildInfo

End Function


Private Sub AddChildToList _
                (Child As IAccessible, _
                 ChildInfo As ChildList)

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Adds an array entry and fills it with the passed IAccessible object. If   '
    ' the object is the currently selected one, the fact is recorded.           '
    '                                                                           '
    ' Called by: GetListOfChildren                                              '
    ' Calls: Nothing                                                            '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    With ChildInfo

        If (Not .Objects) = True Then
            ReDim .Objects(0 To 0)
            ReDim .Levels(LBound(.Objects) To UBound(.Objects))
        Else
            ReDim Preserve .Objects(LBound(.Objects) To UBound(.Objects) + 1)
            ReDim Preserve .Levels(LBound(.Objects) To UBound(.Objects))
        End If

        Set .Objects(UBound(.Objects)) = Child

        If ((Child.accState(CHILDID_SELF) And (STATE_SYSTEM_SELECTED)) _
                                             = STATE_SYSTEM_SELECTED) Then
            .SelectedIndex = UBound(.Objects)
        End If

    End With ' ChildInfo

End Sub

Private Function GetChildren _
                     (Element As IAccessible) _
                 As Variant()

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' General purpose subroutine to get an array of children of an IAccessible  '
    ' object. The returned array is Variant because the elements may be either  '
    ' IAccessible objects or simple (Long) elements, and the caller must treat  '
    ' them appropriately.                                                       '
    '                                                                           '
    ' Called by: GetAccessible when searching for an Accessible element         '
    '            GetListOfChildren when retrieving a list of children           '
    ' Calls: AccessibleChildren API                                             '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Const FirstChild        As Long = 0&

    Dim NumChildren         As Long
    Dim NumReturned         As Long

    Dim ChildrenArray()

    NumChildren = Element.accChildCount

    If NumChildren > 0 Then

        ReDim ChildrenArray(NumChildren - 1)
        AccessibleChildren Element, FirstChild, NumChildren, _
                           ChildrenArray(0), NumReturned

    End If

    GetChildren = ChildrenArray

End Function

Public Function RoleText _
                    (Role As RoleNumber) _
                As String

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Just a wrapper for the GetRoleText API.                                   '
    '                                                                           '
    ' Calls: GetRoleText API - once to get the length and once to get the text. '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim RoleTemp        As String
    Dim RoleTextLength  As Long
    Dim RoleChar()      As Byte
    Dim ndxRoleChar     As Long

    RoleTextLength = GetRoleText(Role, ByVal 0, 0&)
    ReDim RoleChar(0 To RoleTextLength)
    GetRoleText Role, RoleChar(LBound(RoleChar)), RoleTextLength + 1

    For ndxRoleChar = LBound(RoleChar) To UBound(RoleChar) - 1
        RoleTemp = RoleTemp & Chr(RoleChar(ndxRoleChar))
    Next ndxRoleChar

    RoleText = RoleTemp

End Function
Private Function NameAndRoleText _
                      (Info As ChildList, _
                      Optional IncludeRoleText As Boolean = False) _
                 As Variant()

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Builds compound object names and role texts from an IAccessible object    '
    ' and its ancestors up to the appropriate level, as previously determined.  '
    ' The ancestors have not been stored, so are collected here into a simple   '
    ' array before building up the strings.                                     '
    '                                                                           '
    ' Calls: AppendToString to append text, if non-duplicate, and a separator,  '
    '                       if necessary, to a name or role string.             '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Dim ReturnArray(0 To 1)

    Dim NamesArray()    As String
    Dim RolesArray()    As String

    ReDim NamesArray(LBound(Info.Objects) To UBound(Info.Objects))

    If IncludeRoleText Then
        ReDim RolesArray(LBound(Info.Objects) To UBound(Info.Objects))
    End If

    Dim Ancestry()      As IAccessible
    Dim AncestralName   As String
    Dim ndxObject       As Long
    Dim ndxAncestry     As Long

    For ndxObject = LBound(Info.Objects) To UBound(Info.Objects)

        ReDim Ancestry(0 To Info.Levels(ndxObject))

        Set Ancestry(LBound(Ancestry)) = Info.Objects(ndxObject)
        For ndxAncestry = LBound(Ancestry) + 1 To UBound(Ancestry)
            Set Ancestry(ndxAncestry) = Ancestry(ndxAncestry - 1).accParent
        Next ndxAncestry

        For ndxAncestry = UBound(Ancestry) To LBound(Ancestry) Step -1

            AncestralName = ""
            If ndxAncestry < UBound(Ancestry) Then
                AncestralName = Ancestry(ndxAncestry + 1).accName(CHILDID_SELF)
            End If

            If Ancestry(ndxAncestry).accName(CHILDID_SELF) _
                    <> AncestralName Then

                AppendToString NamesArray(ndxObject), _
                               Ancestry(ndxAncestry).accName(CHILDID_SELF)

            End If

            If IncludeRoleText Then
                If Ancestry(ndxAncestry).accRole(CHILDID_SELF) _
                        <> ROLE_SYSTEM_GROUPING Then

                    AppendToString RolesArray(ndxObject), _
                                   RoleText(Ancestry(ndxAncestry) _
                                            .accRole(CHILDID_SELF))

                End If
            End If

        Next ndxAncestry

    Next ndxObject

    NameAndRoleText = Array(NamesArray(), RolesArray())

End Function

Private Sub AppendToString(NameOrRole As String, Appendix As String)

    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Called from NameAndRoleText (q.v., above) to append appropriate text to a '
    ' name or role string.                                                      '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

    Const TextSeparator As String = " - "

    If NameOrRole <> "" Then
        If Right(NameOrRole, Len(TextSeparator)) <> TextSeparator Then

            NameOrRole = NameOrRole & TextSeparator

        End If
    End If

    NameOrRole = NameOrRole & Appendix

End Sub
Click to expand...
This works only if the said tab is active and not if the Home Tab or any other tab is active. Can we not make it dynamic? If not, then the whole point of automation will go for a toss as I need to run this code in loop for multiple excel files.
 
Upvote 0
Here is a small function to activate a given Ribbon Tab which you should hopefully be able to incorporate into your overall code:

You will need to set a reference to the UIAutomationClient library


VBA Code: 
Option Explicit

Public Function ActivateRibbonTab(ByVal strTabName As String) As Boolean
    
    Dim UIA                              As UIAutomationClient.CUIAutomation
    Dim UIElement                        As UIAutomationClient.IUIAutomationElement
    Dim Condition                        As UIAutomationClient.IUIAutomationCondition
    Dim ToolsTab                         As UIAutomationClient.IUIAutomationElement
    Dim LegacyIAccessiblePattern         As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
    
    Set UIA = New CUIAutomation
    Set UIElement = UIA.ElementFromHandle(ByVal Application.Hwnd)
    
    If Not (UIElement Is Nothing) Then
        Set Condition = UIA.CreateAndCondition(UIA.CreatePropertyCondition(UIA_NamePropertyId, ByVal strTabName), _
        UIA.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIRibbonTab"))
        Set ToolsTab = UIElement.FindFirst(TreeScope_Subtree, Condition)
        If Not (ToolsTab Is Nothing) Then
            Set LegacyIAccessiblePattern = ToolsTab.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
            LegacyIAccessiblePattern.DoDefaultAction
            ActivateRibbonTab = True
        End If
    End If

End Function

And then just call it as follows:
VBA Code: 
 ActivateRibbonTab "Dealogic"
 
Upvote 0
_

Alternatively, you could use the C_AccEx I posted here which doesn't require a reference to the UIAutomationClient library and which in my opinion, it is easier to use.

After having added the Class and Intreface to your project , you can use it as follows:

In a new Standard Module:
VBA Code: 
Option Explicit

Function ActivateRibbonItem(ByVal sItem As String) As Boolean
    Dim oParent As C_AccEx, oChild As IAccElement
  
    Set oParent = New C_AccEx
    Call oParent.GetAccessibleChildrenFromHwnd(Application.hwnd, TreeScope_Subtree)
    If oParent.ElementsCount Then
        For Each oChild In oParent.Items
            With oChild
                If LCase(.Name) = LCase(sItem) Then
                    .DoDefaultAction
                    ActivateRibbonItem = True
                End If
            End With
        Next oChild
    End If
End Function

Sub Test()
    If ActivateRibbonItem("Dealogic") And ActivateRibbonItem("Refresh All") Then
        Debug.Print "Success"
    Else
        Debug.Print "failed"
    End If
End Sub
 
Upvote 0
Jaafar Tribak said:
_

Alternatively, you could use the C_AccEx I posted here which doesn't require a reference to the UIAutomationClient library and which in my opinion, it is easier to use.

After having added the Class and Intreface to your project , you can use it as follows:

In a new Standard Module:
VBA Code: 
Option Explicit

Function ActivateRibbonItem(ByVal sItem As String) As Boolean
    Dim oParent As C_AccEx, oChild As IAccElement
 
    Set oParent = New C_AccEx
    Call oParent.GetAccessibleChildrenFromHwnd(Application.hwnd, TreeScope_Subtree)
    If oParent.ElementsCount Then
        For Each oChild In oParent.Items
            With oChild
                If LCase(.Name) = LCase(sItem) Then
                    .DoDefaultAction
                    ActivateRibbonItem = True
                End If
            End With
        Next oChild
    End If
End Function

Sub Test()
    If ActivateRibbonItem("Dealogic") And ActivateRibbonItem("Refresh All") Then
        Debug.Print "Success"
    Else
        Debug.Print "failed"
    End If
End Sub
Click to expand...
This is out of my understanding of VBA. I can see C_AccEx Class and IAccElement Class Interface codes in the other link. Not sure where to paste those and how to use it. If you could please help me out with the steps, it would be a great help and I will learn something new today.
 
Upvote 0
You can download the workbook file demo from the link (AccessibilityEx.xlsm), keep the C_AccEx and IAccElement Class modules and remove the bas_Test Module.

Then, just add a new normal Module and copy/paste the code in this thread's post#16 above and run the Test routine.

PS: Obviously, you won't need Sheet1 from the demo file, so just delete that sheet too.
 
Last edited:
Upvote 0
Jaafar Tribak said:
You can download the workbook file demo from the link (AccessibilityEx.xlsm), keep the C_AccEx and IAccElement Class modules and remove the bas_Test Module.

Then, just add a new normal Module and copy/paste the code in this thread's post#16 above and run the Test routine.

PS: Obviously, you won't need Sheet1 from the demo file, so just delete that sheet too.
Click to expand...
I opted for the first method as I was getting some error with the second approach. Below is the final sub procedure which I want to make it perfect. However, ended up with more errors on line:

Any idea on how do I make it work on other workbooks?

VBA Code: 
If Element.accRole(CHILDID_SELF) = RoleWanted _
    And Element.accName(CHILDID_SELF) = NameWanted Then

VBA Code: 
Sub DealogicRefreshEntireWorkbook()
'ByRef control As IRibbonControl
    Dim MyDealogicApp As COMAddIn
    Dim SelectedFileNames As Variant
    Dim i As Long, CountofFiles As Long
    Dim FileToOpen As Workbook

    SelectedFileNames = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", MultiSelect:=True, Title:="Select Files you want to refresh")
    If IsArray(SelectedFileNames) = False Then Exit Sub
    
   
    CountofFiles = 0
    Set FileToOpen = Nothing
    For i = LBound(SelectedFileNames) To UBound(SelectedFileNames)
        
        Set FileToOpen = Workbooks.Open(SelectedFileNames(i), False)
        CountofFiles = CountofFiles + 1
        With FileToOpen
            .Activate
            
            ActivateRibbonTab "Dealogic"
            ClickCustomButton "Dealogic", "Refresh", "Refresh All"
            Calculate
            .Save
            .Close
        End With
    Next i
    
    
    
    MsgBox ("All done! We have refreshed " & CountofFiles & " Files via Dealogic."), vbInformation

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Auto Scroll Separate Files
2
Replies
14
Views
421
Candyman8019
C
T
  • Question Question
Macros disabled from spreadsheet copy
Replies
2
Views
143
travellerva
T
G
  • Question Question
Advice for Excel integration
Replies
1
Views
292
Jeffrey Mahoney
Jeffrey Mahoney
O
  • Question Question
How to automatically recalculate all workbooks in a office 365 spreadsheet each time its opened without using vba or macros.
Replies
5
Views
293
felixstraube
F
T
  • Solved
Open all files in a folder and delete a column from each?
Replies
4
Views
621
Joe4
Joe4

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

Share this page

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