Word2010のリボンに、Word2000と同じプログラムコードのコピペでユーザー設定ボタンを生成する。（一応ツールバー単位で）

● Word2010のリボンに、Word2000と同じプログラムコードのコピペでユーザー設定ボタンを生成する。（一応ツールバー単位で）

※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
目次
　★ はじめに
　★ Excelの場合との違い
　★ プログラムをコピペする場所と標準モジュールの名前の変え方
　★ コピペするプログラム内容
　(01)ツールバーの各ボタンの動作を決めるプログラム
　(02) リボンに２つのツールバー（各ボタン含む）を生成するプログラム
　(03)前項の(02)のテストプログラムを動かしたい場合は、以下のコードもコピペします。
　★ ツールバーの削除、ボタンの増やし方の方法
※Shift＋TABキー、もしくは、Homeキー、Homeキー＋TAB数回、を押すと、目次付近に戻れます。
　　
　　
★ はじめに

リボンに何もない状態から・・・、「挿入系ツールバー01」というツールバーと、「テキスト操作系ツールバー01」というツールバーが生成されるようにし、前者においては矩形や矢印などを自動挿入、後者においては段落とフォントの自動設定、等々のボタンを配置します。そしてそれらの作業がラクに行えるようにします。

このプログラムは、Word2003、2000などの、古いバージョンでもそのまま使えます。

といいますか、本当は旧バージョンで動くプログラムをバージョン2010でも試してみたら、一応動いてしまい、「完全じゃないけどまあそれなりに使える」という状況になっていたものですから、ご紹介させて頂きました。

本来は、リボンを直接操作するプログラムで「矩形や矢印などを自動挿入のボタン」などをリボンに作るべきだと思いますが、面倒なので、古いバージョンのプログラムでやってみました。（全バージョン共通で動くものがあれば、もともとたくさんのメニューボタンを作るわけではないのでそれはそれで使いやすいかと思い無理矢理動かして使っています・・・。）

下図のような動きになります。

図01：ツールバーの自動配置

図02：ボタンの動きの例-01

図03：ボタンの動きの例-02

※注意
Wordの場合各図形（各オートシェイプ）のアンカーの位置を、各図形ごとに変えたほうがその後のトラブルが少ないようなので、図形を表示したい付近の行の先頭に、いったん点滅カーソルを置いたほうがいいみたいです。Excelの場合はアンカーの概念が無い気がするので必要ないかもしれません。

★ Excelの場合との違い

基本的にほぼ同じプログラム内容でExcelでも行けますが、まず、終盤の(02)でご紹介する『(02) リボンに２つのツールバー（各ボタン含む）を生成するプログラム』の、すべての「OnAction 」の行の、「=」の右側が異なります。

Wordの場合は、マクロのボタンと「挿_矢印_赤1()」というプログラムを紐付けしたい場合、つまり、メニューボタンを押したときに「挿_矢印_赤1()」というプログラムが実行されるようにしたい場合、「挿_矢印_赤1()」が書かれている標準モジュール名を指定します。
「 ×××.OnAction = 標準モジュール名.プロシージャ名」という形です。

例えば下記のようになります。

'
'
myBar.Controls(3).OnAction = "ToolBarButtonCode.挿_矢印_赤1"
'

myBar.Controls(3).OnAction = "ToolBarButtonCode.挿_矢印_赤1"

それに対してExcelの場合は、「 ×××.OnAction = ファイル名!標準モジュールのプロシージャ名」という形です。
例えば下記のようになります。

'
'
myBar.Controls(3).OnAction = "PERSONAL.XLS!cell_hiduke_yyyy_mm_dd"
'

myBar.Controls(3).OnAction = "PERSONAL.XLS!cell_hiduke_yyyy_mm_dd"

あとは、次項の「(01)ツールバーの各ボタンの動作を決めるプログラム」での、すべてのプロシージャの、

Dim myDocument As Document
を
Dim myDocument As Worksheet

に書き換えて、かつ、

Set myDocument = ActiveDocument
を
Set myDocument = ActiveSheet

に書き換えればOKです。
（いずれも一括置換でもOKです。）

また、バージョンによってボタンのIDの番号が変わってくるかもしれないので、もしそうならその場合はさらに変えます。たとえばWord2010の場合、マクロのボタンのIDは「1」のようですので、すべての「myBar.Controls.Add ID:=2950」の「2950」を「1」に書き換えて、「myBar.Controls.Add ID:=1」とします。以下のような感じになります。

'
'
    '2つめのボタンを追加

    myBar.Controls.Add ID:=1    'Word2010の場合。本ツールバーの2つ目のボタン「マクロ」ボタンを追加します
'    myBar.Controls.Add ID:=2950 'Word2000の場合
    myBar.Controls(2).Style = msoButtonIconAndCaption     ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(2).Caption = "hms(&C)"                 ' ボタンの「テキスト」部分を、「hms(&C)」に変更する。「(&C)」を付けないとエラーになる。
'    myBar.Controls(2).OnAction = "PERSONAL.XLS!cell_jikoku_hh_mm_ss"   ' Excelの場合。ボタンを「PERSONAL.XLS」の「cell_jikoku_hh_mm_ss」プロシージャと関連付ける
    myBar.Controls(2).OnAction = "ToolBarButtonCode.挿_矢印_青1"   ' Wordの場合。
'

'2つめのボタンを追加

myBar.Controls.Add ID:=1 'Word2010の場合。本ツールバーの2つ目のボタン「マクロ」ボタンを追加します

' myBar.Controls.Add ID:=2950 'Word2000の場合

myBar.Controls(2).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(2).Caption = "hms(&C)" ' ボタンの「テキスト」部分を、「hms(&C)」に変更する。「(&C)」を付けないとエラーになる。

' myBar.Controls(2).OnAction = "PERSONAL.XLS!cell_jikoku_hh_mm_ss" ' Excelの場合。ボタンを「PERSONAL.XLS」の「cell_jikoku_hh_mm_ss」プロシージャと関連付ける

myBar.Controls(2).OnAction = "ToolBarButtonCode.挿_矢印_青1" ' Wordの場合。

もちろん、ExcelにあってWordに無い命令・メニュー、の場合やその逆の場合は同じプログラムは使えません。

ケースやプログラム内容によっては、丸ごとWordに転用できないこともあるかと思いますが、おおむね、このような違いさえ理解していただければ、今回のようにオートシェイプを挿入するような、ExcelでもWordでも共通なメニューなら、根本的なプログラムとして書く内容は同じです。

※補足01
Wordの場合、メニュー関係の共用部品は「Normal.dot」というファイルに書くことが多いです。「Normal.dot」にプログラムを書くと、すべてのWordファイルにプログラムを保存・上書き保存・実行ができます。「docx」拡張子のファイルを開いていた時でも、「Normal.dot」ファイルにだけはVBAプログラムを保存・上書き保存・実行ができます。

※補足02
Excelの場合のメニュー関係の共用部品は、「C:\Users\ユーザー名\AppData\Roaming\Microsoft\Excel\XLSTART」というフォルダに、まず「PERSONAL.XLS」という名前の空のXLSファイルを作り、その中の標準モジュールに書いたプログラム（プロシージャ）の名前を指定します。ファイル名の拡張子は「xlsm」ではなくて「xls」です。作成したら、いったんそのファイルを開いて「非表示」の設定にして上書き保存して閉じます（「非表示」にしないと普通のExcelファイルを開いたときに「PERSONAL.XLS」もいっしょに画面に表示されてしまうためです）。それで共用部品化設定が完了です。
なお、標準モジュールの名前は何でもいいです。ここでのプログラムは標準モジュール名には左右されません。Excelの場合、左右されるのはファイル名とプロシージャ名のみです。
Wordと同様、どのExcelファイルからもプログラムを保存・上書き保存・実行ができます。

※「PERSONAL.XLS」の作り方
2010の場合、最初、xlsx拡張子として画面が開きますので、先に、マイドキュメントなどに空のxlsファイルを別名保存します。ファイル→名前を付けて保存→ファイルの種類のドロップダウンメニューを「Excel97-2003ブック（xls）」に変更→PERSONAL.XLSという名前で「OK」します。（Excel2010でも「PERSONAL.XLS」という名前でOKです。拡張子はxlsmではなくて「xls」です。）
空のxlsファイルができたら「C:\Users\ユーザー名\AppData\Roaming\Microsoft\Excel\XLSTART」というフォルダに、そのファイルを移動します。

なお、2007以降？の場合は、「xlsb」拡張子ほうのが本当みたいです。自動的に個人用マクロブックとして生成されるのが普通です。でもxls拡張子でも動きます。もしxlsで不具合が出るなら前述の容量で今度は空のxlsbファイルを作って、それにプログラムをインポートすればOKかと思います。（インポートできるのかな？できなかったら単純にモジュールごとにxlsからコピペでOKです。）

移動完了したら、いったんそのファイルを開いて「非表示」の設定にして上書き保存して閉じます。
「非表示」にしないと普通のExcelファイルを開いたときに「PERSONAL.XLS」もいっしょに画面に表示されてしまうためです。これで共用部品化設定が完了です。

非表示設定のしかたは以下のとおりです。
2007以降の場合は「表示」タブ→「ウィンドウ」グループ→「表示しない」でいいようです。
「表示しない」が無いように見えたら、アイコンだけ出ている状態かもしれません。画面を最大化するか横方向に目いっぱい広げるとアイコンと文言の両方が見えると思います。
2003以前の場合は、ウィンドウ→「表示しない」でOKです。

　　
　　
★ プログラムをコピペする場所と標準モジュールの名前の変え方

プログラムはすべて Normal.dot にコピペします。
理由は、Normal.dot に書かれたプログラムは、マクロが動かないはずの「docx」拡張子のファイル上でも動くからです。（さらにその理由は、Normal.dot が、docxやdocmなどのすべてのWordファイルのひな型だからです。Normal.dotで「既定」に設定されたものはすべてのワードファイルの「既定」となるからです。そのため、Normal.dotに書かれたプログラムは拡張子がdocxでもdocmでも共用部品・共用プログラムとして動きます。）

Word2010の場合、「開発」タブ→VisuaiBasic で Normal.dotに標準モジュールを作れるようになります。

下図のように「Visual Basic Editor」が開きますので、まずその画面の左側・上のペインの「Normal」を押します。

この「Normal」は「Normal.dotのプログラムが集まってますよ～」という意味です。

そこをクリックしたら、今度は「挿入」→「標準モジュール」とクリックしていきます。

「Module1」という標準モジュールができます。
多くのプログラムはここにコピペします。

なお、原則としては、標準モジュールにプログラムをコピペすれば、その標準モジュールの名前が「Module1」だろうが「Module2」だろうが何だろうがプログラムは動きます。
ただ、今回のこの記事では、「ある標準モジュールの名前だけは ××× という名前でなければならない」ということをしなければなりません。

そのように何らかの名前変更の指示があった場合だけは、標準モジュールの名前を変えます。

あとはどんな標準モジュール名でもいいので、「共通部品01」とか「ツールバー用」とか「メニューバー用」とか管理しやすい名前に変更します。

なお、標準モジュールの名前を変更するには、下図のようにします。

(01)「挿入」→「標準モジュール」を押して生成された標準モジュール（「Module1」など）をクリック
(02)するとその下にも標準モジュール名が出てくるので、そちら側で名前を変更してEnterします。
(03)上部の標準モジュールの名前にもその変更が反映されます。
　　
　　
★ コピペするプログラム内容

(01)ツールバーの各ボタンの動作を決めるプログラム
Normal.dotに標準モジュールを作り、名前を、「ToolBarButtonCode」にしてからコピペします。

「ToolBarButtonCode」という標準モジュール名は変えないでください。

他の関連プログラムの中で「ToolBarButtonCode」という文字列を直接記述して使っているので、それ以外の標準モジュール名に変えてしまうと全体のプログラムが動かなくなってしまうからです。

'
'
Option Explicit

Sub 挿_丸矩_赤()

    Dim myDocument  As Document
    Dim TopNum01    As Variant
    
    TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")
    
    If TopNum01 = "" Then
        Exit Sub
    Else
    
    End If
    
    Set myDocument = ActiveDocument
    
    With myDocument.Shapes.AddShape(Type:=msoShapeRoundedRectangle, Left:=100, Top:=TopNum01, Width:=100, Height:=50)
        .Line.Weight = 2.25
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.Visible = msoFalse   '塗りつぶし無しに設定。 線無しは .Line.Visible = msoFalse
        
    End With


End Sub


Sub 挿_丸矩_青()

    Dim myDocument  As Document
    Dim TopNum01    As Variant
    
    TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")
    
    If TopNum01 = "" Then
        Exit Sub
    Else
    
    End If
    
    Set myDocument = ActiveDocument
    With myDocument.Shapes.AddShape(Type:=msoShapeRoundedRectangle, Left:=100, Top:=TopNum01, Width:=100, Height:=50)
        .Line.Weight = 2.25
        .Line.ForeColor.RGB = RGB(0, 0, 255)
        .Fill.Visible = msoFalse   '塗りつぶし無しに設定。 線無しは .Line.Visible = msoFalse
        
    End With


End Sub


Sub 挿_テBox_赤1()

    '赤いテキストボックスの生成（枠線の太さは１ポイント）
    Call MakeTxtBox01(1, 255, 0, 0)
        
End Sub


Sub 挿_テBox_青1()

    '青いテキストボックスの生成（枠線の太さは１ポイント）
    Call MakeTxtBox01(1, 0, 0, 255)
    
End Sub


'######################################################################################################
'テキストボックスを、好きな色で挿入するためのプログラムです。
' Call MakeTxtBox01(1,255,0,0) といった形で書いて呼び出し＝実行します。
' LineWNum→枠線の太さを1とか2.25などと指定します。
' aka→RGBの「Red」の値を指定します。
' midori→RGBの「Green」の値を指定します。
' ao→RGBの「Blue」の値を指定します。
'######################################################################################################

Sub MakeTxtBox01(LineWNum As Double, aka As Integer, midori As Integer, ao As Integer)

    Dim myDocument  As Document
    Dim TopNum01    As Variant
    
    TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")
    
    If TopNum01 = "" Then
        Exit Sub
    Else
    
    End If
    
    Set myDocument = ActiveDocument
   
    With myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=TopNum01, Width:=100, Height:=30) 'テキストボックスの生成
        .Line.Weight = LineWNum                     '枠線の太さの設定
        .Line.ForeColor.RGB = RGB(aka, midori, ao)  '枠線の色の設定
        .Fill.BackColor.RGB = RGB(255, 255, 255)    '背景色（塗りつぶし色）を白に。
'        .Fill.Visible = msoFalse   '「.Fill.Visible = msoFalse」で「塗りつぶし無し」の意味。 線無しは .Line.Visible = msoFalse
        .Select  'テキストボックスを選択＝内側に点滅カーソルを点滅させると同義
    End With

    Call 段固10_丸ゴシ8  '段落を固定値の10にしてフォントを丸ゴシックの8に設定
    
End Sub


Sub test01()
'
' 赤いテキストボックスを作って、段落を固定値の10にしてフォントを丸ゴシックの8に設定
   

    Dim myDocument As Document

    Set myDocument = ActiveDocument

    With myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=300, Width:=100, Height:=100)
        .Line.Weight = 1
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.BackColor.RGB = RGB(255, 255, 255)
'        .Fill.Visible = msoFalse   ' 線無しは .Line.Visible = msoFalse
        .Select  'テキストボックスを選択＝内側に点滅カーソルを点滅させると同義
    End With

    Call 段固10_丸ゴシ8  '段落を固定値の10にしてフォントを丸ゴシックの8に設定
    
End Sub


Sub 段固10_丸ゴシ8()

'段落を固定値の10にしてフォントを丸ゴシックの8に設定

' Macro1 Macro
'
'
'    ActiveDocument.Shapes.Range(Array("Text Box 15")).Select
'    Selection.TypeText Text:="aaaあああ"
'    Selection.MoveLeft Unit:=wdCharacter, Count:=6, Extend:=wdExtend
    Selection.Font.Name = "HG丸ｺﾞｼｯｸM-PRO"
    Selection.Font.Size = 8
'    Selection.TypeText Text:="　あああああ"
'    Selection.MoveLeft Unit:=wdCharacter, Count:=5, Extend:=wdExtend
    With Selection.ParagraphFormat
        .LeftIndent = MillimetersToPoints(0)
        .RightIndent = MillimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceExactly
        .LineSpacing = 10
        .Alignment = wdAlignParagraphJustify
        .WidowControl = False
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = MillimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
'        .MirrorIndents = False              'Word2000でエラーになるのでコメントアウト
'        .TextboxTightWrap = wdTightNone     'Word2000でエラーになるのでコメントアウト
        .AutoAdjustRightIndent = True
        .DisableLineHeightGrid = False
        .FarEastLineBreakControl = True
        .WordWrap = True
        .HangingPunctuation = True
        .HalfWidthPunctuationOnTopOfLine = False
        .AddSpaceBetweenFarEastAndAlpha = True
        .AddSpaceBetweenFarEastAndDigit = True
        .BaseLineAlignment = wdBaselineAlignAuto
    End With
End Sub


'######################################################################################################
'矢印を、好きな色で挿入するためのプログラムです。
' Call MakeArrowLine01(1,255,0,0) といった形で書いて呼び出し＝実行します。
' LineWNum→矢印の線の太さを1とか2.25などと指定します。
' aka→RGBの「Red」の値を指定します。
' midori→RGBの「Green」の値を指定します。
' ao→RGBの「Blue」の値を指定します。
'######################################################################################################

Sub MakeArrowLine01(LineWNum As Double, aka As Integer, midori As Integer, ao As Integer)

    Dim myDocument  As Document
    Dim TopNum01    As Variant
    
    TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")
    
    If TopNum01 = "" Then
        Exit Sub
    Else
    
    End If
    
    '矢印の作成
    '矢印の終端や始端の形は以下の7種類から選べます。
        'msoArrowheadNone
        'msoArrowheadOval
        'msoArrowheadStyleMixed
        'msoArrowheadDiamond
        'msoArrowheadOpen
        '|msoArrowheadStealth
        'msoArrowheadTriangle|
    'また、始端の形の設定は、上記の7つを「BeginArrowheadWidth 」で指定すれば良いようです。

    Set myDocument = ActiveDocument                                     '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。
    With myDocument.Shapes.AddLine(300, TopNum01, 250, TopNum01 + 50)   '直線の生成
        .Line.Weight = LineWNum                                         '矢印の線の太さを設定する
        .Line.ForeColor.RGB = RGB(aka, midori, ao)                      '線の色を設定する
'        .Fill.BackColor.RGB = RGB(255, 255, 255)
'        .Fill.Visible = msoFalse   '「.Fill.Visible = msoFalse」で「塗りつぶし無し」の意味。 線無しは .Line.Visible = msoFalse
        .Line.EndArrowheadStyle = msoArrowheadOpen                      '終端の形を設定する
        .Select                                                         '矢印を選択
    End With
       
       
End Sub


Sub 挿_矢印_青1()

    '青い矢印の生成（線の太さは１ポイント）
    Call MakeArrowLine01(1, 0, 0, 255)
    
End Sub


Sub 挿_矢印_赤1()

    '赤い矢印の生成（線の太さは１ポイント）
    Call MakeArrowLine01(1, 255, 0, 0)
    
End Sub


'######################################################################################################
'丸角矩形と矢印を、好きな色で挿入するためのプログラムです。
' Call MakeRoundSquareSet01(255,0,0,1) といった形で書いて呼び出し＝実行します。
' LineWNum→矢印の線の太さを1とか2.25などと指定します。矩形の線の太さは2.25固定にしてあります。
' aka→RGBの「Red」の値を指定します。
' midori→RGBの「Green」の値を指定します。
' ao→RGBの「Blue」の値を指定します。
'######################################################################################################

Sub MakeRoundSquareSet01(aka As Integer, midori As Integer, ao As Integer, LineWNum As Double)

    Dim myDocument  As Document
    Dim TopNum01    As Variant

    
    'まずユーザーに図形を挿入する高さ（縦の位置）を聞きます。
    '点滅カーソルのあるページの100～700までの縦の位置を指定してもらいます。（単位はピクセル）
    '100だと上のほう、350だと真ん中へん、700だと下のほうに挿入されます。
    '入力してもらう数値は150でも236でも何でもOKです。
    
    TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")
    
        
        
    '「キャンセル」が押されたときのエラー回避処理
    'ユーザーに高さを聞くときInputboxというものを使っていますが、
    'Inputboxでは「キャンセル」が押されると、空文字（「""」と表記します）が
    '返事として返ってくるのでそれを利用します。
    
    If TopNum01 = "" Then
        '「キャンセル」が押されたときの処理
        Exit Sub  'Subプロシージャ（＝このプログラム）自体を抜ける＝終わる
    Else
        '押されなければ何もせず次へ
    End If
    
    
    
    '丸角矩形の作成
    Set myDocument = ActiveDocument                     '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。
    With myDocument.Shapes.AddShape(Type:=msoShapeRoundedRectangle, Left:=100, Top:=TopNum01, Width:=100, Height:=50) '丸角矩形の生成
        .Line.Weight = 2.25                             '矩形の線の太さは2.25固定で。
        .Line.ForeColor.RGB = RGB(aka, midori, ao)      '線の色を設定する
        .Fill.Visible = msoFalse                        '線無しは .Line.Visible = msoFalse
        
    End With

    
    
    '矢印の作成
        '矢印の終端や始端の形は以下の7種類から選べます。
            'msoArrowheadNone
            'msoArrowheadOval
            'msoArrowheadStyleMixed
            'msoArrowheadDiamond
            'msoArrowheadOpen
            '|msoArrowheadStealth
            'msoArrowheadTriangle|
        'また、始端の形の設定は、上記の7つを「BeginArrowheadWidth 」で指定すれば良いようです。
    Set myDocument = ActiveDocument                 '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。
    With myDocument.Shapes.AddLine(300, TopNum01, 250, TopNum01 + 50) '直線の生成
        .Line.Weight = LineWNum                     '矢印の線の太さを設定する
        .Line.ForeColor.RGB = RGB(aka, midori, ao)  '線の色を設定する
        .Line.EndArrowheadStyle = msoArrowheadOpen  '終端の形を設定する
        .Select                                     '矢印を選択
    End With
    


End Sub


Sub 挿_丸矩セット_赤()

    '線の太さ「1」の矢印と、赤枠のテキストボックスを一括挿入します。
    '「255, 0, 0」が「赤」を意味しています。
    '最後の「1」が矢印の線の太さの設定値です。
    
    Call MakeRoundSquareSet01(255, 0, 0, 1)

End Sub


'######################################################################################################
'テキストボックスと矢印を、好きな色で挿入するためのプログラムです。
'テキストボックスの段落は固定値の10、フォントは丸ゴシックProの8に設定してあります
' Call MakeTboxSet01(255,0,0,1) といった形で書いて呼び出し＝実行します。
' LineWNum→矢印の線の太さを1とか2.25などと指定します。矩形の線の太さは2.25固定にしてあります。
' aka→RGBの「Red」の値を指定します。
' midori→RGBの「Green」の値を指定します。
' ao→RGBの「Blue」の値を指定します。
'######################################################################################################

Sub MakeTboxSet01(aka As Integer, midori As Integer, ao As Integer, LineWNum As Double)

    Dim myDocument  As Document
    Dim TopNum01    As Variant

    
    'ユーザーに図形を挿入する高さ（縦の位置）を聞きます。
    '点滅カーソルのあるページの100～700までの縦の位置を指定してもらいます。（単位はピクセル）
    '100だと上のほう、350だと真ん中へん、700だと下のほうに挿入されます。
    '入力してもらう数値は150でも236でも何でもOKです。
    
    TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")
    
        
        
    '「キャンセル」が押されたときのエラー回避処理
    'ユーザーに高さを聞くときInputboxというものを使っていますが、
    'Inputboxでは「キャンセル」が押されると、空文字（「""」と表記します）が
    '返事として返ってくるのでそれを利用します。
    
    If TopNum01 = "" Then
        '「キャンセル」が押されたときの処理
        Exit Sub  'Subプロシージャ（＝このプログラム）自体を抜ける＝終わる
    Else
        '押されなければ何もせず次へ
    End If
    
    
    
    'テキストボックスの作成
    Set myDocument = ActiveDocument
    With myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=TopNum01, Width:=100, Height:=30)  'テキストボックスの生成
        .Line.Weight = LineWNum                     '枠線の太さの設定
        .Line.ForeColor.RGB = RGB(aka, midori, ao)  '枠線の色の設定
        .Fill.BackColor.RGB = RGB(255, 255, 255)    '背景色（塗りつぶし色）を白に。
'        .Fill.Visible = msoFalse   '「.Fill.Visible = msoFalse」で「塗りつぶし無し」の意味。 線無しは .Line.Visible = msoFalse
        .Select  'テキストボックスを選択＝内側に点滅カーソルを点滅させると同義
    End With

    Call 段固10_丸ゴシ8  '段落を固定値の10にしてフォントを丸ゴシックの8に設定

    
    
    '矢印の作成
        '矢印の終端や始端の形は以下の7種類から選べます。
            'msoArrowheadNone
            'msoArrowheadOval
            'msoArrowheadStyleMixed
            'msoArrowheadDiamond
            'msoArrowheadOpen
            '|msoArrowheadStealth
            'msoArrowheadTriangle|
        'また、始端の形の設定は、上記の7つを「BeginArrowheadWidth 」で指定すれば良いようです。
    Set myDocument = ActiveDocument                                     '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。
    With myDocument.Shapes.AddLine(300, TopNum01, 250, TopNum01 + 50)   '直線の生成
        .Line.Weight = LineWNum                                         '矢印の線の太さを設定する
        .Line.ForeColor.RGB = RGB(aka, midori, ao)                      '線の色を設定する
        .Line.EndArrowheadStyle = msoArrowheadOpen                      '終端の形を設定する
        .Select                                                         '矢印を選択
    End With
    


End Sub


Sub 挿_テBoxセット_赤()

    '線の太さ「1」の矢印と、赤枠のテキストボックスを一括挿入します。
    '（テキストボックスのフォントは丸ゴシックProの8ポイントで段落は固定値の10ポイント）
    '「255, 0, 0」が「赤」を意味しています。
    '最後の「1」が矢印の線の太さの設定値です。
    
    Call MakeTboxSet01(255, 0, 0, 1)

End Sub

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

Option Explicit

Sub 挿_丸矩_赤()

Dim myDocument As Document

Dim TopNum01 As Variant

TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")

If TopNum01 = "" Then

Exit Sub

Else

End If

Set myDocument = ActiveDocument

With myDocument.Shapes.AddShape(Type:=msoShapeRoundedRectangle, Left:=100, Top:=TopNum01, Width:=100, Height:=50)

.Line.Weight = 2.25

.Line.ForeColor.RGB = RGB(255, 0, 0)

.Fill.Visible = msoFalse '塗りつぶし無しに設定。線無しは .Line.Visible = msoFalse

End With

End Sub

Sub 挿_丸矩_青()

Dim myDocument As Document

Dim TopNum01 As Variant

TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")

If TopNum01 = "" Then

Exit Sub

Else

End If

Set myDocument = ActiveDocument

With myDocument.Shapes.AddShape(Type:=msoShapeRoundedRectangle, Left:=100, Top:=TopNum01, Width:=100, Height:=50)

.Line.Weight = 2.25

.Line.ForeColor.RGB = RGB(0, 0, 255)

.Fill.Visible = msoFalse '塗りつぶし無しに設定。線無しは .Line.Visible = msoFalse

End With

End Sub

Sub 挿_テBox_赤1()

'赤いテキストボックスの生成（枠線の太さは１ポイント）

Call MakeTxtBox01(1, 255, 0, 0)

End Sub

Sub 挿_テBox_青1()

'青いテキストボックスの生成（枠線の太さは１ポイント）

Call MakeTxtBox01(1, 0, 0, 255)

End Sub

'######################################################################################################

'テキストボックスを、好きな色で挿入するためのプログラムです。

' Call MakeTxtBox01(1,255,0,0) といった形で書いて呼び出し＝実行します。

' LineWNum→枠線の太さを1とか2.25などと指定します。

' aka→RGBの「Red」の値を指定します。

' midori→RGBの「Green」の値を指定します。

' ao→RGBの「Blue」の値を指定します。

'######################################################################################################

Sub MakeTxtBox01(LineWNum As Double, aka As Integer, midori As Integer, ao As Integer)

Dim myDocument As Document

Dim TopNum01 As Variant

TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")

If TopNum01 = "" Then

Exit Sub

Else

End If

Set myDocument = ActiveDocument

With myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=TopNum01, Width:=100, Height:=30) 'テキストボックスの生成

.Line.Weight = LineWNum '枠線の太さの設定

.Line.ForeColor.RGB = RGB(aka, midori, ao) '枠線の色の設定

.Fill.BackColor.RGB = RGB(255, 255, 255) '背景色（塗りつぶし色）を白に。

' .Fill.Visible = msoFalse '「.Fill.Visible = msoFalse」で「塗りつぶし無し」の意味。線無しは .Line.Visible = msoFalse

.Select 'テキストボックスを選択＝内側に点滅カーソルを点滅させると同義

End With

Call 段固10_丸ゴシ8 '段落を固定値の10にしてフォントを丸ゴシックの8に設定

End Sub

Sub test01()

' 赤いテキストボックスを作って、段落を固定値の10にしてフォントを丸ゴシックの8に設定

Dim myDocument As Document

Set myDocument = ActiveDocument

With myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=300, Width:=100, Height:=100)

.Line.Weight = 1

.Line.ForeColor.RGB = RGB(255, 0, 0)

.Fill.BackColor.RGB = RGB(255, 255, 255)

' .Fill.Visible = msoFalse ' 線無しは .Line.Visible = msoFalse

.Select 'テキストボックスを選択＝内側に点滅カーソルを点滅させると同義

End With

Call 段固10_丸ゴシ8 '段落を固定値の10にしてフォントを丸ゴシックの8に設定

End Sub

Sub 段固10_丸ゴシ8()

'段落を固定値の10にしてフォントを丸ゴシックの8に設定

' Macro1 Macro

' ActiveDocument.Shapes.Range(Array("Text Box 15")).Select

' Selection.TypeText Text:="aaaあああ"

' Selection.MoveLeft Unit:=wdCharacter, Count:=6, Extend:=wdExtend

Selection.Font.Name = "HG丸ｺﾞｼｯｸM-PRO"

Selection.Font.Size = 8

' Selection.TypeText Text:="　あああああ"

' Selection.MoveLeft Unit:=wdCharacter, Count:=5, Extend:=wdExtend

With Selection.ParagraphFormat

.LeftIndent = MillimetersToPoints(0)

.RightIndent = MillimetersToPoints(0)

.SpaceBefore = 0

.SpaceBeforeAuto = False

.SpaceAfter = 0

.SpaceAfterAuto = False

.LineSpacingRule = wdLineSpaceExactly

.LineSpacing = 10

.Alignment = wdAlignParagraphJustify

.WidowControl = False

.KeepWithNext = False

.KeepTogether = False

.PageBreakBefore = False

.NoLineNumber = False

.Hyphenation = True

.FirstLineIndent = MillimetersToPoints(0)

.OutlineLevel = wdOutlineLevelBodyText

.CharacterUnitLeftIndent = 0

.CharacterUnitRightIndent = 0

.CharacterUnitFirstLineIndent = 0

.LineUnitBefore = 0

.LineUnitAfter = 0

' .MirrorIndents = False 'Word2000でエラーになるのでコメントアウト

' .TextboxTightWrap = wdTightNone 'Word2000でエラーになるのでコメントアウト

.AutoAdjustRightIndent = True

.DisableLineHeightGrid = False

.FarEastLineBreakControl = True

.WordWrap = True

.HangingPunctuation = True

.HalfWidthPunctuationOnTopOfLine = False

.AddSpaceBetweenFarEastAndAlpha = True

.AddSpaceBetweenFarEastAndDigit = True

.BaseLineAlignment = wdBaselineAlignAuto

End With

End Sub

'######################################################################################################

'矢印を、好きな色で挿入するためのプログラムです。

' Call MakeArrowLine01(1,255,0,0) といった形で書いて呼び出し＝実行します。

' LineWNum→矢印の線の太さを1とか2.25などと指定します。

' aka→RGBの「Red」の値を指定します。

' midori→RGBの「Green」の値を指定します。

' ao→RGBの「Blue」の値を指定します。

'######################################################################################################

Sub MakeArrowLine01(LineWNum As Double, aka As Integer, midori As Integer, ao As Integer)

Dim myDocument As Document

Dim TopNum01 As Variant

TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")

If TopNum01 = "" Then

Exit Sub

Else

End If

'矢印の作成

'矢印の終端や始端の形は以下の7種類から選べます。

'msoArrowheadNone

'msoArrowheadOval

'msoArrowheadStyleMixed

'msoArrowheadDiamond

'msoArrowheadOpen

'|msoArrowheadStealth

'msoArrowheadTriangle|

'また、始端の形の設定は、上記の7つを「BeginArrowheadWidth 」で指定すれば良いようです。

Set myDocument = ActiveDocument '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。

With myDocument.Shapes.AddLine(300, TopNum01, 250, TopNum01 + 50) '直線の生成

.Line.Weight = LineWNum '矢印の線の太さを設定する

.Line.ForeColor.RGB = RGB(aka, midori, ao) '線の色を設定する

' .Fill.BackColor.RGB = RGB(255, 255, 255)

' .Fill.Visible = msoFalse '「.Fill.Visible = msoFalse」で「塗りつぶし無し」の意味。線無しは .Line.Visible = msoFalse

.Line.EndArrowheadStyle = msoArrowheadOpen '終端の形を設定する

.Select '矢印を選択

End With

End Sub

Sub 挿_矢印_青1()

'青い矢印の生成（線の太さは１ポイント）

Call MakeArrowLine01(1, 0, 0, 255)

End Sub

Sub 挿_矢印_赤1()

'赤い矢印の生成（線の太さは１ポイント）

Call MakeArrowLine01(1, 255, 0, 0)

End Sub

'######################################################################################################

'丸角矩形と矢印を、好きな色で挿入するためのプログラムです。

' Call MakeRoundSquareSet01(255,0,0,1) といった形で書いて呼び出し＝実行します。

' LineWNum→矢印の線の太さを1とか2.25などと指定します。矩形の線の太さは2.25固定にしてあります。

' aka→RGBの「Red」の値を指定します。

' midori→RGBの「Green」の値を指定します。

' ao→RGBの「Blue」の値を指定します。

'######################################################################################################

Sub MakeRoundSquareSet01(aka As Integer, midori As Integer, ao As Integer, LineWNum As Double)

Dim myDocument As Document

Dim TopNum01 As Variant

'まずユーザーに図形を挿入する高さ（縦の位置）を聞きます。

'点滅カーソルのあるページの100～700までの縦の位置を指定してもらいます。（単位はピクセル）

'100だと上のほう、350だと真ん中へん、700だと下のほうに挿入されます。

'入力してもらう数値は150でも236でも何でもOKです。

TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")

'「キャンセル」が押されたときのエラー回避処理

'ユーザーに高さを聞くときInputboxというものを使っていますが、

'Inputboxでは「キャンセル」が押されると、空文字（「""」と表記します）が

'返事として返ってくるのでそれを利用します。

If TopNum01 = "" Then

'「キャンセル」が押されたときの処理

Exit Sub 'Subプロシージャ（＝このプログラム）自体を抜ける＝終わる

Else

'押されなければ何もせず次へ

End If

'丸角矩形の作成

Set myDocument = ActiveDocument '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。

With myDocument.Shapes.AddShape(Type:=msoShapeRoundedRectangle, Left:=100, Top:=TopNum01, Width:=100, Height:=50) '丸角矩形の生成

.Line.Weight = 2.25 '矩形の線の太さは2.25固定で。

.Line.ForeColor.RGB = RGB(aka, midori, ao) '線の色を設定する

.Fill.Visible = msoFalse '線無しは .Line.Visible = msoFalse

End With

'矢印の作成

'矢印の終端や始端の形は以下の7種類から選べます。

'msoArrowheadNone

'msoArrowheadOval

'msoArrowheadStyleMixed

'msoArrowheadDiamond

'msoArrowheadOpen

'|msoArrowheadStealth

'msoArrowheadTriangle|

'また、始端の形の設定は、上記の7つを「BeginArrowheadWidth 」で指定すれば良いようです。

Set myDocument = ActiveDocument '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。

With myDocument.Shapes.AddLine(300, TopNum01, 250, TopNum01 + 50) '直線の生成

.Line.Weight = LineWNum '矢印の線の太さを設定する

.Line.ForeColor.RGB = RGB(aka, midori, ao) '線の色を設定する

.Line.EndArrowheadStyle = msoArrowheadOpen '終端の形を設定する

.Select '矢印を選択

End With

End Sub

Sub 挿_丸矩セット_赤()

'線の太さ「1」の矢印と、赤枠のテキストボックスを一括挿入します。

'「255, 0, 0」が「赤」を意味しています。

'最後の「1」が矢印の線の太さの設定値です。

Call MakeRoundSquareSet01(255, 0, 0, 1)

End Sub

'######################################################################################################

'テキストボックスと矢印を、好きな色で挿入するためのプログラムです。

'テキストボックスの段落は固定値の10、フォントは丸ゴシックProの8に設定してあります

' Call MakeTboxSet01(255,0,0,1) といった形で書いて呼び出し＝実行します。

' LineWNum→矢印の線の太さを1とか2.25などと指定します。矩形の線の太さは2.25固定にしてあります。

' aka→RGBの「Red」の値を指定します。

' midori→RGBの「Green」の値を指定します。

' ao→RGBの「Blue」の値を指定します。

'######################################################################################################

Sub MakeTboxSet01(aka As Integer, midori As Integer, ao As Integer, LineWNum As Double)

Dim myDocument As Document

Dim TopNum01 As Variant

'ユーザーに図形を挿入する高さ（縦の位置）を聞きます。

'点滅カーソルのあるページの100～700までの縦の位置を指定してもらいます。（単位はピクセル）

'100だと上のほう、350だと真ん中へん、700だと下のほうに挿入されます。

'入力してもらう数値は150でも236でも何でもOKです。

TopNum01 = InputBox("配置する高さの位置を100～700の数字で指定してください")

'「キャンセル」が押されたときのエラー回避処理

'ユーザーに高さを聞くときInputboxというものを使っていますが、

'Inputboxでは「キャンセル」が押されると、空文字（「""」と表記します）が

'返事として返ってくるのでそれを利用します。

If TopNum01 = "" Then

'「キャンセル」が押されたときの処理

Exit Sub 'Subプロシージャ（＝このプログラム）自体を抜ける＝終わる

Else

'押されなければ何もせず次へ

End If

'テキストボックスの作成

Set myDocument = ActiveDocument

With myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=TopNum01, Width:=100, Height:=30) 'テキストボックスの生成

.Line.Weight = LineWNum '枠線の太さの設定

.Line.ForeColor.RGB = RGB(aka, midori, ao) '枠線の色の設定

.Fill.BackColor.RGB = RGB(255, 255, 255) '背景色（塗りつぶし色）を白に。

' .Fill.Visible = msoFalse '「.Fill.Visible = msoFalse」で「塗りつぶし無し」の意味。線無しは .Line.Visible = msoFalse

.Select 'テキストボックスを選択＝内側に点滅カーソルを点滅させると同義

End With

Call 段固10_丸ゴシ8 '段落を固定値の10にしてフォントを丸ゴシックの8に設定

'矢印の作成

'矢印の終端や始端の形は以下の7種類から選べます。

'msoArrowheadNone

'msoArrowheadOval

'msoArrowheadStyleMixed

'msoArrowheadDiamond

'msoArrowheadOpen

'|msoArrowheadStealth

'msoArrowheadTriangle|

'また、始端の形の設定は、上記の7つを「BeginArrowheadWidth 」で指定すれば良いようです。

Set myDocument = ActiveDocument '操作対象となるファイルを、点滅カーソルのあるファイルに指定します。

With myDocument.Shapes.AddLine(300, TopNum01, 250, TopNum01 + 50) '直線の生成

.Line.Weight = LineWNum '矢印の線の太さを設定する

.Line.ForeColor.RGB = RGB(aka, midori, ao) '線の色を設定する

.Line.EndArrowheadStyle = msoArrowheadOpen '終端の形を設定する

.Select '矢印を選択

End With

End Sub

Sub 挿_テBoxセット_赤()

'線の太さ「1」の矢印と、赤枠のテキストボックスを一括挿入します。

'（テキストボックスのフォントは丸ゴシックProの8ポイントで段落は固定値の10ポイント）

'「255, 0, 0」が「赤」を意味しています。

'最後の「1」が矢印の線の太さの設定値です。

Call MakeTboxSet01(255, 0, 0, 1)

End Sub

(02) リボンに２つのツールバー（各ボタン含む）を生成するプログラム
Normal.dotに標準モジュールを作り、名前を、「MakeToolBar」にしてからコピペします。
実はこちらのプログラムでは、(01)と違って「MakeToolBar」という名前を変えても動きますが、一応、判別しやすいようにその名前で作ってみてください。

コピペしたあとに、「MultipleCmdBarAllAdd01()」を実行すると、各ボタンと機能を備えた「挿入系ツールバー01」というツールバーと、「テキスト操作系ツールバー01」というツールバーの、２つのツールバーがリボンに生成されます。

'
'
Option Explicit

'##################################################################################
'複数のツールバーを一括してチェックと登録をするプログラムです。
'Word2010なら、現在の「アドイン」タブのツールバーを右クリックで全部削除してから
'実行します。ツールバーを全部削除した時点で同時に「アドイン」タブが消えます。
'その状態になってから実行します。
'##################################################################################

Sub MultipleCmdBarAllAdd01()

    '挿入系のツールバーを生成（リボンがあるバージョンなら「アドイン」タブができてその中に生成されます）
    Call CmdBarChkAndAdd_TypeInsert01
    
    'テキスト操作系のツールバーを生成（リボンがあるバージョンなら「アドイン」タブができてその中に生成されます）
    Call CmdBarChkAndAdd_TypeTxtOpe01

End Sub


'##################################################################################
'「挿入系ツールバー01」ツールバーが存在するかをチェックして、無ければ再作成します。
'ボタンの表示形式を「イメージとテキスト」にします。（Wordの場合は絵が出ませんが。）
'##################################################################################

Sub CmdBarChkAndAdd_TypeInsert01()
    
    Dim myBar As CommandBar, i As Long, C
    Dim StrBarChkTxt As String
    
    
    'ここで、作りたいツールバーの名前を「挿入系ツールバー01」に決めておきます。
    'なお、ここで別の名前に書き換えれば、たとえボタンの内容が同じだったとしても
    '別のツールバーとして、リボンの「アドイン」タブに新しく生成されます。
    StrBarChkTxt = "挿入系ツールバー01"
    
    For Each C In CommandBars
        If C.Name = StrBarChkTxt Then
            '既に、「StrBarChkTxt = "ツールバーの名前"」の行で指定した名前のツールバーが存在したら
            '非表示になってるといけないので、
            '表示してから終わる。
            C.Visible = True
            Exit Sub
        Else
            
        End If
    Next C
    
    '直前のループを最後まで実行したとき
    '指定した名前のツールバーが見つからなかった時はここに来るので、
    '必要に応じて以下のメッセージを発する。
'    MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようです。再作成してください。"
'    MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようですので再作成します。"
    
    Set myBar = CommandBars.Add               '空っぽのツールバーを作成
    myBar.Name = StrBarChkTxt                 'その空っぽのツールバーに名前をつけます。



    '各ボタンの追加
    'もし新しいボタンを追加したいときはカッコの中の数字を間違わないこと。
    '1が1つ目のボタン、2が2つ目のボタン・・・という意味です。
    
    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(1).Style = msoButtonIconAndCaption               ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(1).Caption = "挿丸矩赤(&C)"                      ' ボタンの「テキスト」部分を、「hms(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(1).OnAction = "ToolBarButtonCode.挿_丸矩_赤"     ' ボタンを「NORMAL.DOT」の「cell_jikoku_hh_mm_ss」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(2).Style = msoButtonIconAndCaption               ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(2).Caption = "挿丸矩青(&C)"                      ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(2).OnAction = "ToolBarButtonCode.挿_丸矩_青"     ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(3).Style = msoButtonIconAndCaption               ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(3).Caption = "挿テBox赤1(&C)"                    ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(3).OnAction = "ToolBarButtonCode.挿_テBox_赤1"   ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(4).Style = msoButtonIconAndCaption               ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(4).Caption = "挿テBox青1(&C)"                    ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(4).OnAction = "ToolBarButtonCode.挿_テBox_青1"   ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(5).Style = msoButtonIconAndCaption               ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(5).Caption = "挿矢印赤1(&C)"                     ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(5).OnAction = "ToolBarButtonCode.挿_矢印_赤1"    ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(6).Style = msoButtonIconAndCaption               ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(6).Caption = "挿矢印青1(&C)"                     ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(6).OnAction = "ToolBarButtonCode.挿_矢印_青1"    ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(7).Style = msoButtonIconAndCaption                   ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(7).Caption = "丸矩セット赤(&C)"                      ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(7).OnAction = "ToolBarButtonCode.挿_丸矩セット_赤"   ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    myBar.Controls.Add ID:=1     '「マクロ」ボタンを追加します
    myBar.Controls(8).Style = msoButtonIconAndCaption                   ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(8).Caption = "TBoxセット赤(&C)"                      ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(8).OnAction = "ToolBarButtonCode.挿_テBoxセット_赤"  ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    'ツールバーを可視化します。
    myBar.Visible = True


End Sub


'##################################################################################
'「テキスト操作系ツールバー01」ツールバーが存在するかをチェックして、無ければ再作成します。
'ボタンの表示形式を「イメージとテキスト」にします。（Wordの場合は絵が出ませんが。）
'##################################################################################

Sub CmdBarChkAndAdd_TypeTxtOpe01()
    
    Dim myBar As CommandBar, i As Long, C
    Dim StrBarChkTxt As String
    
    
    'ここで、作りたいツールバーの名前を「テキスト操作系ツールバー01」に決めておきます。
    'なお、ここで別の名前に書き換えれば、たとえボタンの内容が同じだったとしても
    '別のツールバーとして、リボンの「アドイン」タブに新しく生成されます。
    StrBarChkTxt = "テキスト操作系ツールバー01"
    
    For Each C In CommandBars
        If C.Name = StrBarChkTxt Then
            '既に、「StrBarChkTxt = "ツールバーの名前"」の行で指定した名前のツールバーが存在したら
            '非表示になってるといけないので、
            '表示してから終わる。
            C.Visible = True
            Exit Sub
        Else
            
        End If
    Next C
    
    '直前のループを最後まで実行したとき
    '指定した名前のツールバーが見つからなかった時はここに来るので、
    '必要に応じて以下のメッセージを発する。
'    MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようです。再作成してください。"
'    MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようですので再作成します。"
    
    Set myBar = CommandBars.Add               '空っぽのツールバーを作成
    myBar.Name = StrBarChkTxt                 'その空っぽのツールバーに名前をつけます。



    '各ボタンの追加
    'もし新しいボタンを追加したいときはカッコの中の数字を間違わないこと。
    '1が1つ目のボタン、2が2つ目のボタン・・・という意味です。
    
    myBar.Controls.Add ID:=1                                            '「マクロ」ボタンを追加します
    myBar.Controls(1).Style = msoButtonIconAndCaption                   ' ボタンの表示形式を「イメージとテキスト」にする。
    myBar.Controls(1).Caption = "段固10_丸ゴシ8(&C)"                    ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。
    myBar.Controls(1).OnAction = "ToolBarButtonCode.段固10_丸ゴシ8"     ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

    
    'ツールバーを可視化します。
    myBar.Visible = True


End Sub





Sub CmcBtnCaptionIdChk02()
'ツールバーのボタンIDを調べて、その結果の（設定値の）文字列をクリップボードへ送ります。
'「ツールバー名-----ボタンの表示名-----ボタンID」、といった形で設定値がクリップボードへ送られます。
'ここに載ってこなかったものに関しては、「マクロの記録」機能で調べます。
'目的のボタンを押すまでを「マクロの記録」で記録し、VBEでそのプログラム内容を確認すると、
'「ID:=2950, ・・・」みたいな形で分かります。
'なお、このコードを実行するには別途で、ClipBoard_SetData() など、クリップボード操作のプログラムが必要です。
'https://euc-access-excel-db.com/tips/ct07_se/ct075010_ac2ktips/access2000tips-win32-api-clipboad
'を参照して、先に「クリップボード操作」という名前でいいので
'クリップボード操作用の標準モジュールを作っておいてください。

    Dim myBar       As CommandBar, i As Long, C
    Dim ConfigStr   As String
    Dim ctl         As Object
    

    For Each C In CommandBars

        Debug.Print C.Name


        For Each ctl In CommandBars(C.Name).Controls

            'Debug.Print C.Name & "-----" & ctl.Caption & "-----" & ctl.ID
            
            ConfigStr = ConfigStr & vbCrLf & C.Name & "-----" & ctl.Caption & "-----" & ctl.ID
        Next ctl
      
    Next C
    
    Call ClipBoard_SetData(ConfigStr)

End Sub

Sub CmcBtnCaptionIdChk()
'イミディエイトでのチェック用です。
'ここに載ってこなかったものに関しては、「マクロの記録」機能で調べます。
'目的のボタンを押すまでを「マクロの記録」で記録し、VBEでそのプログラム内容を確認すると、
'「ID:=2950, ・・・」みたいな形で分かります。

    Dim myBar As CommandBar, i As Long, C
    Dim ctl         As CommandBarControl

    For Each C In CommandBars

        Debug.Print C.Name


        For Each ctl In CommandBars(C.Name).Controls

            Debug.Print C.Name & "-----" & ctl.Caption & "-----" & ctl.ID
            
        Next ctl
      
    Next C
    
    
End Sub

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

Option Explicit

'##################################################################################

'複数のツールバーを一括してチェックと登録をするプログラムです。

'Word2010なら、現在の「アドイン」タブのツールバーを右クリックで全部削除してから

'実行します。ツールバーを全部削除した時点で同時に「アドイン」タブが消えます。

'その状態になってから実行します。

'##################################################################################

Sub MultipleCmdBarAllAdd01()

'挿入系のツールバーを生成（リボンがあるバージョンなら「アドイン」タブができてその中に生成されます）

Call CmdBarChkAndAdd_TypeInsert01

'テキスト操作系のツールバーを生成（リボンがあるバージョンなら「アドイン」タブができてその中に生成されます）

Call CmdBarChkAndAdd_TypeTxtOpe01

End Sub

'##################################################################################

'「挿入系ツールバー01」ツールバーが存在するかをチェックして、無ければ再作成します。

'ボタンの表示形式を「イメージとテキスト」にします。（Wordの場合は絵が出ませんが。）

'##################################################################################

Sub CmdBarChkAndAdd_TypeInsert01()

Dim myBar As CommandBar, i As Long, C

Dim StrBarChkTxt As String

'ここで、作りたいツールバーの名前を「挿入系ツールバー01」に決めておきます。

'なお、ここで別の名前に書き換えれば、たとえボタンの内容が同じだったとしても

'別のツールバーとして、リボンの「アドイン」タブに新しく生成されます。

StrBarChkTxt = "挿入系ツールバー01"

For Each C In CommandBars

If C.Name = StrBarChkTxt Then

'既に、「StrBarChkTxt = "ツールバーの名前"」の行で指定した名前のツールバーが存在したら

'非表示になってるといけないので、

'表示してから終わる。

C.Visible = True

Exit Sub

Else

End If

Next C

'直前のループを最後まで実行したとき

'指定した名前のツールバーが見つからなかった時はここに来るので、

'必要に応じて以下のメッセージを発する。

' MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようです。再作成してください。"

' MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようですので再作成します。"

Set myBar = CommandBars.Add '空っぽのツールバーを作成

myBar.Name = StrBarChkTxt 'その空っぽのツールバーに名前をつけます。

'各ボタンの追加

'もし新しいボタンを追加したいときはカッコの中の数字を間違わないこと。

'1が1つ目のボタン、2が2つ目のボタン・・・という意味です。

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(1).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(1).Caption = "挿丸矩赤(&C)" ' ボタンの「テキスト」部分を、「hms(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(1).OnAction = "ToolBarButtonCode.挿_丸矩_赤" ' ボタンを「NORMAL.DOT」の「cell_jikoku_hh_mm_ss」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(2).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(2).Caption = "挿丸矩青(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(2).OnAction = "ToolBarButtonCode.挿_丸矩_青" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(3).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(3).Caption = "挿テBox赤1(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(3).OnAction = "ToolBarButtonCode.挿_テBox_赤1" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(4).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(4).Caption = "挿テBox青1(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(4).OnAction = "ToolBarButtonCode.挿_テBox_青1" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(5).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(5).Caption = "挿矢印赤1(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(5).OnAction = "ToolBarButtonCode.挿_矢印_赤1" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(6).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(6).Caption = "挿矢印青1(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(6).OnAction = "ToolBarButtonCode.挿_矢印_青1" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(7).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(7).Caption = "丸矩セット赤(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(7).OnAction = "ToolBarButtonCode.挿_丸矩セット_赤" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(8).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(8).Caption = "TBoxセット赤(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(8).OnAction = "ToolBarButtonCode.挿_テBoxセット_赤" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

'ツールバーを可視化します。

myBar.Visible = True

End Sub

'##################################################################################

'「テキスト操作系ツールバー01」ツールバーが存在するかをチェックして、無ければ再作成します。

'ボタンの表示形式を「イメージとテキスト」にします。（Wordの場合は絵が出ませんが。）

'##################################################################################

Sub CmdBarChkAndAdd_TypeTxtOpe01()

Dim myBar As CommandBar, i As Long, C

Dim StrBarChkTxt As String

'ここで、作りたいツールバーの名前を「テキスト操作系ツールバー01」に決めておきます。

'なお、ここで別の名前に書き換えれば、たとえボタンの内容が同じだったとしても

'別のツールバーとして、リボンの「アドイン」タブに新しく生成されます。

StrBarChkTxt = "テキスト操作系ツールバー01"

For Each C In CommandBars

If C.Name = StrBarChkTxt Then

'既に、「StrBarChkTxt = "ツールバーの名前"」の行で指定した名前のツールバーが存在したら

'非表示になってるといけないので、

'表示してから終わる。

C.Visible = True

Exit Sub

Else

End If

Next C

'直前のループを最後まで実行したとき

'指定した名前のツールバーが見つからなかった時はここに来るので、

'必要に応じて以下のメッセージを発する。

' MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようです。再作成してください。"

' MsgBox "「" & StrBarChkTxt & "」ツールバーが消えてしまっているようですので再作成します。"

Set myBar = CommandBars.Add '空っぽのツールバーを作成

myBar.Name = StrBarChkTxt 'その空っぽのツールバーに名前をつけます。

'各ボタンの追加

'もし新しいボタンを追加したいときはカッコの中の数字を間違わないこと。

'1が1つ目のボタン、2が2つ目のボタン・・・という意味です。

myBar.Controls.Add ID:=1 '「マクロ」ボタンを追加します

myBar.Controls(1).Style = msoButtonIconAndCaption ' ボタンの表示形式を「イメージとテキスト」にする。

myBar.Controls(1).Caption = "段固10_丸ゴシ8(&C)" ' ボタンの「テキスト」部分を、「ymd(&C)」に変更する。「(&C)」を付けないとエラーになる。

myBar.Controls(1).OnAction = "ToolBarButtonCode.段固10_丸ゴシ8" ' ボタンを「NORMAL.DOT」の「cell_hiduke_yyyy_mm_dd」プロシージャと関連付ける

'ツールバーを可視化します。

myBar.Visible = True

End Sub

Sub CmcBtnCaptionIdChk02()

'ツールバーのボタンIDを調べて、その結果の（設定値の）文字列をクリップボードへ送ります。

'「ツールバー名-----ボタンの表示名-----ボタンID」、といった形で設定値がクリップボードへ送られます。

'ここに載ってこなかったものに関しては、「マクロの記録」機能で調べます。

'目的のボタンを押すまでを「マクロの記録」で記録し、VBEでそのプログラム内容を確認すると、

'「ID:=2950, ・・・」みたいな形で分かります。

'なお、このコードを実行するには別途で、ClipBoard_SetData() など、クリップボード操作のプログラムが必要です。

'https://euc-access-excel-db.com/tips/ct07_se/ct075010_ac2ktips/access2000tips-win32-api-clipboad

'を参照して、先に「クリップボード操作」という名前でいいので

'クリップボード操作用の標準モジュールを作っておいてください。

Dim myBar As CommandBar, i As Long, C

Dim ConfigStr As String

Dim ctl As Object

For Each C In CommandBars

Debug.Print C.Name

For Each ctl In CommandBars(C.Name).Controls

'Debug.Print C.Name & "-----" & ctl.Caption & "-----" & ctl.ID

ConfigStr = ConfigStr & vbCrLf & C.Name & "-----" & ctl.Caption & "-----" & ctl.ID

Next ctl

Next C

Call ClipBoard_SetData(ConfigStr)

End Sub

Sub CmcBtnCaptionIdChk()

'イミディエイトでのチェック用です。

'ここに載ってこなかったものに関しては、「マクロの記録」機能で調べます。

'目的のボタンを押すまでを「マクロの記録」で記録し、VBEでそのプログラム内容を確認すると、

'「ID:=2950, ・・・」みたいな形で分かります。

Dim myBar As CommandBar, i As Long, C

Dim ctl As CommandBarControl

For Each C In CommandBars

Debug.Print C.Name

For Each ctl In CommandBars(C.Name).Controls

Debug.Print C.Name & "-----" & ctl.Caption & "-----" & ctl.ID

Next ctl

Next C

End Sub

(03)前項の(02)のテストプログラムを動かしたい場合は、以降に挙げたのサイトのコードもコピペします。
新しく標準モジュールを作り、「クリップボード操作」という名前に変えてからコピペします。

「Access2000Tips Win32 API クリップボードへ変数などの文字を送る、クリップボードの文字を取得する」
https://euc-access-excel-db.com/tips/ct07_se/ct075010_ac2ktips/access2000tips-win32-api-clipboad
をご参照ください。

この処理は、僕は(有)ロードシステム様のサンプルをそのまま使わせて頂いています。
このサイトは有益な情報がたくさんありますから、皆さんもぜひ見てみてください。

(有)ロードシステム様
http://www.loadsystem.jp/api/

コピペするのは、
http://www.loadsystem.jp/api/api15.htm の「Source」の内容です。

直リンクだと
http://www.loadsystem.jp/api/lsapi15.txt の内容を標準モジュールにコピペするだけで使えます。

ただし、ここでは、クリップボードに送れる文字数を増やすために、

Public Const MAXSIZE = 4096

の行だけ、

Public Const MAXSIZE = 15000000

と、書き換えて上書き保存します。

それで完了です。
　　
　　
★ ツールバーの削除、ボタンの増やし方の方法

ツールバーの削除は、ツールバーのどのボタンの上でもいいので右クリックして「ユーザー設定のツールバーの削除」でOKです。

「アドイン」タブの中に単一のツールバーしかない場合、それを削除すると、同時に「アドイン」タブも消えます。

複数のツールバーが生成されていた場合、最後のツールバーが削除されると「アドイン」タブも消えます。

再度、プログラムでツールバーを自動生成すると、同名のツールバーが生成されます。
（本サンプルでは「テキスト操作系ツールバー01」ツールバーや「挿入系ツールバー01」ツールバー。）

新しくボタンを追加したい場合は、まず先に、「ToolBarButtonCode」標準モジュールに、追加するボタンにどんなプログラムを実行させたいかのプロシージャを書きます。
その後、そのプロシージャとどんなボタンを紐付けするかを、既存のツールバー生成のプロシージャに追記します。

本サンプルだと、「CmdBarChkAndAdd_TypeInsert01()」や「CmdBarChkAndAdd_TypeTxtOpe01()」です。「CmdBarChkAndAdd_TypeInsert01()」に9個目、10個目、あるいは、「CmdBarChkAndAdd_TypeTxtOpe01()」に2つ目、3つ目、とボタンの登録のプログラムを追加します。

そして、いったん、既存のツールバーを削除してから、再度、同じ名前でツールバーを登録します。

つまり、右クリック→「ユーザー設定のツールバーの削除」にて、「テキスト操作系ツールバー01」ツールバーと「挿入系ツールバー01」ツールバーをいったん削除してから、再度、「MultipleCmdBarAllAdd01()」を実行します。

ボタンを増やしたいときはこれの繰り返しとなります。

　　
　　
※関連記事
Excel2010のリボンに、Excel2000と同じプログラムコードのコピペでユーザー設定ボタンを生成する。（一応ツールバー単位で）
https://euc-access-excel-db.com/tips/ct08_exceltruebasic/ct080860_vba_basic/tool-bar-auto-make-excel

投稿タグ: ExcelVBA, Excelの独学, Excel連携VBA, パソコンでの自動化, ビジネスパソコンの基礎, リボンのカスタマイズ, 自動化

MENU

関連記事

最近の投稿

カテゴリー

MENU

Word2010のリボンに、Word2000と同じプログラムコードのコピペでユーザー設定ボタンを生成する。（一応ツールバー単位で）

関連記事

最近の投稿

カテゴリー

タグ