access2010 IAccessible.accStateプロパティ(oleacc)

accStateプロパティを参照して、リボンが最小化されているか調べる。
また、リボンの最小化を実行する。

Option Compare Database
Option Explicit

Const CHILDID_SELF = 0&
Const OBJID_CLIENT = &HFFFFFFFC
Const ROLE_SYSTEM_PUSHBUTTON = &H2B

Declare PtrSafe Function AccessibleChildren Lib "oleacc" ( _
                                ByVal paccContainer As IAccessible, _
                                ByVal iChildStart As Long, _
                                ByVal cChildren As Long, _
                                ByRef rgvarChildren As Any, _
                                ByRef pcObtained As Long _
                                ) As Long

Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
                                ByVal hWnd As LongPtr, _
                                ByVal dwId As Long, _
                                riid As Any, _
                                ByRef ppvObject As IAccessible _
                                ) As Long

Declare PtrSafe Function IIDFromString Lib "ole32" ( _
                                ByVal lpsz As LongPtr, _
                                lpiid As Any _
                                ) As Long
 
Declare PtrSafe Function FindWindowEx Lib "user32" _
                                Alias "FindWindowExA" ( _
                                ByVal hWnd1 As LongPtr, _
                                ByVal hWnd2 As LongPtr, _
                                ByVal lpsz1 As String, _
                                ByVal lpsz2 As String _
                                ) As LongPtr

'リボンが最小化されているかどうか
Function IsRibbonMinimize() As Boolean
    Dim IID(0 To 3) As Long, acc As IAccessible, targetAcc As IAccessible
    
    IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), _
                  IID(0)
    AccessibleObjectFromWindow getHwnd, _
                               OBJID_CLIENT, _
                               IID(0), _
                               acc
    Set targetAcc = GetAcc(acc, "リボンの最小化", ROLE_SYSTEM_PUSHBUTTON)
    
    Select Case targetAcc.accState(CHILDID_SELF)
        Case 1048576
            IsRibbonMinimize = False
        Case 1048584
            IsRibbonMinimize = True
    End Select
End Function

'リボンを最小化する
Sub RibbonMinimize()
    Dim IID(0 To 3) As Long, acc As IAccessible, targetAcc As IAccessible
    
    IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), _
                  IID(0)
    AccessibleObjectFromWindow getHwnd, _
                               OBJID_CLIENT, _
                               IID(0), _
                               acc
    Set targetAcc = GetAcc(acc, "リボンの最小化", ROLE_SYSTEM_PUSHBUTTON)
    
    If targetAcc.accState(CHILDID_SELF) = 1048576 Then
        targetAcc.accDoDefaultAction CHILDID_SELF
    End If
End Sub

Function getHwnd() As LongPtr
    Dim pHwnd As LongPtr
    pHwnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
    pHwnd = FindWindowEx(pHwnd, 0, "MsoCommandBar", "Ribbon")
    pHwnd = FindWindowEx(pHwnd, 0, "MsoWorkPane", "Ribbon")
    pHwnd = FindWindowEx(pHwnd, 0, "NUIPane", "")
    pHwnd = FindWindowEx(pHwnd, 0, "NetUIHWND", "")
    getHwnd = pHwnd
End Function

'**** 引用 http://www.ka-net.org/ ****
Function GetAcc(myAcc As IAccessible, _
                        myAccName As String, _
                        myAccRole As Long _
                        ) As IAccessible
  Dim ReturnAcc As IAccessible
  Dim ChildAcc As IAccessible
  Dim List() As Variant
  Dim Count As Long
  Dim i As Long
    
  If (myAcc.accState(CHILDID_SELF) <> 32769) And _
     (myAcc.accName(CHILDID_SELF) = myAccName) And _
     (myAcc.accRole(CHILDID_SELF) = myAccRole) Then
    Set ReturnAcc = myAcc
  Else
    Count = myAcc.accChildCount
    If Count > 0& Then
      ReDim List(Count - 1&)
      If AccessibleChildren(myAcc, 0&, ByVal Count, List(0), Count) = 0& Then
        For i = LBound(List) To UBound(List)
          If TypeOf List(i) Is IAccessible Then
            Set ChildAcc = List(i)
            Set ReturnAcc = GetAcc(ChildAcc, myAccName, myAccRole)
            If Not ReturnAcc Is Nothing Then Exit For
          End If
        Next
      End If
    End If
  End If
  Set GetAcc = ReturnAcc
End Function