Excel VBAでExcelのリボン操作を行いたい。

投稿者 : f6ae     投稿日時 : 2023/02/09(Thu) 23:37:07     OS : Windows 10     EXCEL : Office 365

---

こんにちは。
Teratailで質問(https://teratail.com/questions/u2so2)を行ったのですが、回答がつかず、自分でも未だ解決できないため、
こちらでも質問させてください。

楽天証券が用意しているマーケットスピードⅡRSSというExcelはアドインがあります。
このアドインは追加後、Excelを起動し、
Excelリボンに追加された「マーケットスピードII」タブの中の「接続」ボタンを押さなければ作動しないため、
その操作をExcel VBAで自動化したいと考えています。

https://www.ka-net.org/ribbon/ri14.html
こちらのコードを参考にして、
以下のようにすることで、「マーケットスピード II」のタブをExcel VBAで選択することに成功しました。

ExcelVBA
```

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, "マーケットスピード II", 37)
  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

```


GetAcc関数内の「myAcc.accName(CHILDID_SELF)」をMsgBoxで出力してみたところ、
マーケットスピードタブ内の接続ボタン「未接続」ボタンも取れる事が分かったため、
以下のように書き換えれば未接続ボタンをクリックさせる事ができるのではないかと考えたのですが、
「実行時エラー：91　オブジェクト変数またはWithブロック変数が設定されていません。」
と出てしまいます。
※myAcc.accRole(CHILDID_SELF)は43(ROLE_SYSTEM_PUSHBUTTON)であることが分かっています。

ExcelVBA
```
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, "未接続", 43)
  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

```


どのようにすれば「未接続」ボタンをクリックさせることが出来るでしょうか。

投稿者 : tek     投稿日時 : 2023/02/11(Sat) 11:37:29

---

レスが付かないようなので、

（リボンタブ）開発-COMアドイン-Microsoft Data Streamer for Excel を追加して、
提示のコードでタブ選択を試みました。
昨日は動作しましたが、本日はエラー出力されました。
私の能力では、IAccessibleについて詳細なドキュメントを見つけられず、解析しようがありません。

その方式ではアドバイス出来ませんので、不安定と言われるSendKeysを提案します。

たとえば、以下のコードをシートに配置した図形に登録すれば、キャプチャ画面になります。

Sub キャプチャ()
    CreateObject("WScript.Shell").SendKeys "%Y2C"
End Sub

投稿者 : tek     投稿日時 : 2023/02/12(Sun) 14:39:07

---

一応昨日のData Streamerのキャプチャ画面は動作させることができました。
但し、グレーアウトのコマンドには対応していません。

変更点のみ

Sub main()
    Ribbon実行 "Data Streamer", "キャプチャ画面"
End Sub

Sub Ribbon実行(myTabName As String, cmd As String)
    Dim myAcc As Office.IAccessible
  
    On Error GoTo myErr
  
    Set myAcc = Application.CommandBars("Ribbon")
    Set myAcc = GetAcc(myAcc, myTabName, ROLE_SYSTEM_PAGETAB)
    myAcc.accDoDefaultAction CHILDID_SELF
    Set myAcc = Application.CommandBars("Ribbon")
    Set myAcc = GetAcc(myAcc, cmd, ROLE_SYSTEM_PUSHBUTTON)
    myAcc.accDoDefaultAction CHILDID_SELF
    Exit Sub
  
myErr:
    MsgBox "実行時エラー:" & Err.Number & vbCrLf & Err.Description, _
         vbCritical, "処理が失敗しました。"
End Sub

投稿者 : f6ae     投稿日時 : 2023/03/02(Thu) 23:22:44

---

返信が大変遅くなってしまい申し訳ございません。
詳細に回答いただきありがとうございます。

SendKeysの方法については、IAccessibleの方法を試す前に実装していたのですが、
やはり不安定なのと、画面のロック時にSendKeysでは動いてくれないという問題がありました。

IAccessibleの方法については、
提示いただいたコードでDataStreamerの「キャプチャ画面」ボタンをクリックしたのと同じ操作が実現致しました。
しかし、マーケットスピードIIの「未接続」ボタンを同じようなコードで操作しようとするとやはり、
myAcc.accDoDefaultAction CHILDID_SELF
の部分で
「実行時エラー：91　オブジェクト変数またはWithブロック変数が設定されていません。」
と出てしまいます。。。
同じボタンなので同じように操作出来るのではと思うのですが、何故こちらは操作出来ないのでしょう。。。
他に方法は無いものでしょうか。