カスタム検索
リボン関連

 

トップページ > リボン関連 > マクロでクイックアクセスツールバーをリボンの下に表示する

 

Sponsored Links

マクロでクイックアクセスツールバーをリボンの下に表示する

今回はマクロでクイックアクセスツールバーをリボンの下に表示する方法を紹介します。

 

[標準モジュール]
※ コードのレイアウトが崩れて表示される場合は、ページのフォントサイズを小さくして閲覧してください。

Option Explicit

Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private Const CHILDID_SELF = 0&
Private Const ROLE_SYSTEM_PUSHBUTTON = &H2B
Private Const ROLE_SYSTEM_MENUITEM = &HC

Sub BelowRibbonQAT(myFlag As Boolean)
'myFlag(True:QATをリボンの下に表示 , False:QATをリボンの上に表示)

  Dim accBtn As Office.IAccessible
  Dim accMenu As Office.IAccessible
  
  On Error GoTo myErr
  Call LockWindowUpdate(GetDesktopWindow())    '画面描画停止
  
  Set accBtn = Application.CommandBars("Ribbon")
  Set accBtn = GetAcc(accBtn, "ツール バーのカスタマイズ", ROLE_SYSTEM_PUSHBUTTON)
  accBtn.accDoDefaultAction (CHILDID_SELF)
  DoEvents    'IAccessibleアクセス待ち
  
  If myFlag = True Then
    Set accMenu = GetAcc(accBtn, "リボンの下に表示", ROLE_SYSTEM_MENUITEM)
  Else
    Set accMenu = GetAcc(accBtn, "リボンの上に表示", ROLE_SYSTEM_MENUITEM)
  End If
  
  If accMenu Is Nothing Then
    'ツールバーのカスタマイズプルダウン解除
    If accBtn.accState(CHILDID_SELF) = &H100008 Then accBtn.accDoDefaultAction (CHILDID_SELF)
  Else
    accMenu.accDoDefaultAction (CHILDID_SELF)
    Set accMenu = Nothing
  End If
  Set accBtn = Nothing
  
  Call LockWindowUpdate(0&)    '画面描画再開
  Exit Sub
  
myErr:
  MsgBox "実行時エラー:" & Err.Number & vbCrLf & Err.Description, _
         vbCritical, "処理が失敗しました。"
End Sub

Private Function GetAcc(myAcc As Office.IAccessible, myAccName As String, myAccRole As Long) As Office.IAccessible
  Dim ReturnAcc As Office.IAccessible
  Dim ChildAcc As Office.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 Office.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

上記コードを標準モジュールに貼り付け、下記コードのように引数を「True」にして呼び出せば、マクロでクイックアクセスツールバーをリボンの下に表示することができます。
逆に引数を「False」にすることで、クイックアクセスツールバーをリボンの上に表示することができます。

Sub Sample()
  Call BelowRibbonQAT(True)
End Sub

※ 上記コードをAccessで実行する際は、事前にコード中の「Office.IAccessible」となっている部分を「IAccessible」に変更し、「system32」フォルダ内の「oleacc.dll」ファイルを参照してください。
※ 上記コードはOfficeのバージョン変更等に伴って、正常に動作しなくなる可能性があります。

トップページ > リボン関連 > マクロでクイックアクセスツールバーをリボンの下に表示する