カスタム検索
リボン関連

リボンのタブを動的に切り替える

今回はマクロでリボンのタブを切り替える方法を紹介します。

 

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

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 Const CHILDID_SELF = 0&
Private Const NAVDIR_FIRSTCHILD = &H7

'accRole
Private Const ROLE_SYSTEM_PROPERTYPAGE = &H26  'リボン , タブ , ステータス バー
Private Const ROLE_SYSTEM_TOOLBAR = &H16  'クイック アクセス ツール バー , グループ
Private Const ROLE_SYSTEM_PAGETABLIST = &H3C  'リボン タブ
Private Const ROLE_SYSTEM_PANE = &H10  '下リボン
Private Const ROLE_SYSTEM_GROUPING = &H14  'コンテキスト タブのヘッダー
Private Const ROLE_SYSTEM_PAGETAB = &H25  'コンテキスト タブ(書式等)
Private Const ROLE_SYSTEM_BUTTONDROPDOWNGRID = &H3A  'Microsoft Office ボタン
Private Const ROLE_SYSTEM_PUSHBUTTON = &H2B  'ボタン

Sub SelRibbonTAB(myTabName As String)
  Dim myAcc As Office.IAccessible
  
  On Error GoTo myErr
  
  Set myAcc = Application.CommandBars("Ribbon")
  Set myAcc = GetAcc(myAcc, "リボン タブ", ROLE_SYSTEM_PAGETABLIST)
  Set myAcc = GetAcc(myAcc, myTabName, ROLE_SYSTEM_PAGETAB)
  myAcc.accDoDefaultAction (CHILDID_SELF)
  Set myAcc = Nothing
  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

上記コードを標準モジュールに貼り付け、下記コードのようにタブ名を引数にして呼び出せば、リボンのタブを動的に切り替えることができます。

Sub Sample()
  Call SelRibbonTAB("表示")
End Sub

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

 

Word Excel PowerPoint Access
ホーム ホーム ホーム ホーム
挿入 挿入 挿入 作成
ページ レイアウト ページ レイアウト デザイン 外部データ
参考資料 数式 アニメーション データベース ツール
差し込み文書 データ スライド ショー ソース管理
校閲 校閲 校閲 アドイン
表示 表示 表示  
開発 開発 開発  
アドイン アドイン アドイン  

※ 「」印がついているタブは表示されていない場合があります。