ボタンの名前からコントロールIDを探すマクロ、IDを使ってセルの右クリックメニューに既存のボタン追加

セルの右クリックメニューに既存のボタン追加

よく使う機能(ボタン)を追加した

値の貼り付け、書式の貼り付け、行列を入れ替えて貼り付け、図をファイルから挿入

エクセル2007専用

Sub ボタン追加するマクロ()
Dim bName As String: bName = "形式を選択して"
Dim ind As Long
Dim c As CommandBarControl

For Each c In Application.CommandBars("Cell").Controls
If Left(c.Caption, Len(bName)) = bName Then
ind = c.Index
Exit For
End If
Next

'行列を入れ替える
Application.CommandBars("Cell").Controls.Add id:=5838, before:=ind
'書式の貼り付け
Application.CommandBars("Cell").Controls.Add id:=369, before:=ind
'値の貼り付け
Application.CommandBars("Cell").Controls.Add id:=370, before:=ind
'図をファイルから挿入
Set c = Application.CommandBars("Cell").Controls.Add(id:=2619)
c.Caption = "図をファイルから挿入"
End Sub

追加するボタンの位置を決める

形式を選択して～の上(前)に追加したいので形式を選択して～のIndexを取得する必要がある

この処理が2～11行目

単純に名前の文字列で検索している、結果は見た目通り4番めだった

14行目

行列を入れ替えるボタンをIDで指定して4番目に追加

形式を選択して～は5番目になる

16行目で書式の貼り付けを4番目に追加

形式を選択して～、行列を入れ替えるは1つづつ下がっていく

18行目で値の貼り付けボタンを4番目に追加

これで貼り付け関連の3つのボタンはOK！

20行目

最後の図をファイルから挿入ボタンはボタンの名前を書き換えるために変数に入れている

ボタンを追加する場所は一番下、これはBeforeプロパティを指定しなければいい

21行目でボタンの名前を書き換えている

そのままの名前だと

ファイルからってなっていてわかりづらい

「行列を入れ替える」より「行列を入れ替えて貼り付け」のほうがいいなあ

'行列を入れ替える
Application.CommandBars("Cell").Controls.Add id:=5838, before:=ind

13,14行目の↑これを↓に書き換える

'行列を入れ替える
Set c = Application.CommandBars("Cell").Controls.Add(id:=5838, before:=ind)
c.Caption = "行列を入れ替えて貼り付け"

できた

IDさえわかれば…

ボタンを追加するにはボタンのコントロールIDってのが必要

値の貼り付けのボタンなら370とかって決められている番号で、エクセルのバージョンによって同じボタンでも番号が違うらしい

ググったんだけど「書式の貼り付け」のIDが見つからない！もしかしてボタン自体がないのかと思ったけど

エクセルのオプション→ユーザー設定→コマンドの選択ですべてのコマンド

これで探したらあるじゃない！でもポップアップをよく見たらリボンにないコマンドってある、リボンから外されているからないのかも？

でもどうしてもIDが知りたい！右クリックメニューに登録したい！

ボタンの名前からIDを探すマクロ(は不要になった、詳しくはページ下の追記)

Sub コマンドボタンID探索()
    Dim cbName As String
    cbName = "書式の貼り付け" '←探したいコマンドの名前を入れる
    'コマンドの名前はエクセルのオプション→ユーザー設定→
    'コマンドの選択→すべてのコマンドで表示された一覧から探す
    'CommandBarの中のCommandBarControlの中のCommandBarControlまで探索する
    Dim strLen As Long
    strLen = Len(cbName)
    Dim isFind As Boolean:  isFind = False
    Dim ccCount As Long
    
    On Error Resume Next
    Dim str As String
    Dim c As CommandBar
    Dim cc As CommandBarControl
    Dim ccc As CommandBarControl
    '一度に探索するとエクセル自体が落ちるので50づつくらいにした方がいい
    'For j = 1 To 50
    'For j = 51 To 100
    'For j = 101 To 150
    'For j = 151 To 200
    For j = 1 To Application.CommandBars.Count '179
        Set c = Application.CommandBars.Item(j)
        For i = 1 To c.Controls.Count
            Set cc = c.Controls.Item(i)
            ccCount = cc.Controls.Count
            If ccCount = 0 Then GoTo ccErr
            For k = 1 To ccCount
                Set ccc = cc.Controls.Item(k)
                If Left(ccc.Caption, strLen) = cbName Then
                    str = "CommandBar.Index = " & c.Index & " : " & c.NameLocal & vbNewLine
                    str = str & "CommandBarControl.Index = " & cc.Index & " : " & cc.Caption & vbNewLine
                    str = str & "CommandBarControl.Index = " & ccc.Index & " : " & ccc.Caption & vbNewLine
                    str = str & "ID = " & ccc.id
                    MsgBox str
                    isFind = True
                End If
            Next
            If Left(cc.Caption, strLen) = cbName Then
                str = "CommandBar.Index = " & c.Index & " : " & c.NameLocal & vbNewLine
                str = str & "CommandBarControl.Index = " & cc.Index & " : " & cc.Caption & vbNewLine
                str = str & "ID = " & cc.id
                MsgBox str
                isFind = True
            End If
ccErr:
        Next
    Next
    If isFind = False Then
        MsgBox cbName & " は見つかりませんでした"
    End If
End Sub

探索する範囲(深さ)は

CommandBar
	└CommandBarControl
		└CommandBarControl

2段階までなので、これ以上深いところにあるボタンは見つけられない

3行目の

cbName = "書式の貼り付け" '←探したいコマンドの名前を入れる

ここにボタンの名前を入れて実行

「書式の貼り付け」で検索した結果

IDが369ってのがわかった！

IDの上の3行は見つかったボタンの場所でこの場合は

コマンドバーの170番目のコマンド追加って名前の中の

コマンドバーコントロールの2番めの編集って名前の中の

コマンドバーコントロールの9番目ってこと

IDさえわかればいいなら必要ないね

ボタンが見つからなかった場合も

メッセージを出すようにしているけど

これが必要じゃなく、ボタンの場所表示も要らなければコードは短くなって↓

Sub コマンドボタンID探索()
    Dim cbName As String
    cbName = "書式の貼り付け" '←探したいコマンドの名前を入れる
    'コマンドの名前はエクセルのオプション→ユーザー設定→
    'コマンドの選択→すべてのコマンドで表示された一覧から探す
    'CommandBarの中のCommandBarControlの中のCommandBarControlまで探索する
    Dim strLen As Long
    strLen = Len(cbName)
    Dim ccCount As Long
    
    On Error Resume Next
    Dim str As String
    Dim c As CommandBar
    Dim cc As CommandBarControl
    Dim ccc As CommandBarControl
    '一度に探索するとエクセル自体が落ちるので50づつくらいにした方がいい
    'For j = 1 To 50
    'For j = 51 To 100
    'For j = 101 To 150
    'For j = 151 To 200
    For j = 1 To Application.CommandBars.Count '179
        Set c = Application.CommandBars.Item(j)
        For i = 1 To c.Controls.Count
            Set cc = c.Controls.Item(i)
            ccCount = cc.Controls.Count
            If ccCount = 0 Then GoTo ccErr
            For k = 1 To ccCount
                Set ccc = cc.Controls.Item(k)
                If Left(ccc.Caption, strLen) = cbName Then
                    str = str & "ID = " & ccc.id
                    MsgBox str
                End If
            Next
            If Left(cc.Caption, strLen) = cbName Then
                str = str & "ID = " & cc.id
                MsgBox str
            End If
ccErr:
        Next
    Next
End Sub

これであっていると思うんだけどなぜかエラーでエクセル自体が終了してしまうことがある

今の環境でCommandBarの種類は179あって、これを一度に探索すると高確率でエラー、50個づつに分けて探索したら確率がかなり減った、でも0じゃないんだよなあ。

ボタンの名前は左から検索するので例えば "書式の" で探した場合は "書式の" で始まるボタンすべてが対象になって、見つかった数だけメッセージが出ることになる

これでボタンの名前さえわかればIDを取得することができるようになって、書式の貼り付けボタンを登録することができたけど、長かったなあ

右クリックメニューに登録した結果

いままでは値の貼り付けや行列を入れ替えて貼り付けは

この画面で小さなラジオボタンをクリックしたり合計4回もクリックしていたけど

2回のクリックで済むようになった、マウスの移動距離も短い！

2017/02/22追記ここから

Download 2007 Office System Document: Lists of Control IDs from Official Microsoft Download Center
https://www.microsoft.com/en-us/download/details.aspx?id=3582

ここにエクセル2007のコントロールID一覧のエクセルファイルがあるのを見つけたので、ここまで長々と書いてきたID検索マクロは不要になったＹＯ

なんていうか本家にあったのね、前回気づかなかったのは英語を無視していたからかなあ、日本語サイトにはないみたい？

ダウンロードした2007OfficeControlIDsExcel2007.EXEを展開して

ExcelRibbonControls.xlsxってファイルを開くと

f:id:gogowaten:20191030154605p:plain