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

Irek1974

Board Regular
Joined
Jul 17, 2009
Messages
64
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 because they installed Excell 2010 on our computers.
From that moment the code above doesn't work.

could anyone help please ?
regards,
I.
 
OK, this is a bit of a guess, but based on Tony Jollans' excellent Ribbon code, add this code to a normal module, then try running the Click_Refresh macro:
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

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

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
Sub Click_Refresh()
    ClickCustomButton "Smart View", "Data", "Refresh"
End Sub
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

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Forum statistics

Threads
1,223,896
Messages
6,175,264
Members
452,627
Latest member
KitkatToby

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