挿入した画像に図表番号を挿入するマクロ(Word)
文書に挿入した画像にマクロで図表番号を付ける(Word)
最近、やたらマニュアルの類を作成している。
スクリーンショット等の画像を貼り付けた文書を作成することがやたら多くなったのだが、いちいち図表番号を入れるのが面倒になってきた。
……となると、当然VBAの出番なのである。
Selection.InsertCaptionメソッド
文書の編集作業をしながらサクッと図表番号を挿入することができたら素敵である。
画像を挿入するたびに、クイック アクセス ツール バーとか、ショートカットキーでサクッとやるイメージ。
そこで、Selection.InsertCaption
メソッドを使うことにする。
Selection.InsertCaptionメソッドの書式
Selection.InsertCaption
メソッドの書式は、『Word2013 developer docs』(Word2013のオフライン・ヘルプ)によると、
expression .InsertCaption(Label, Title, TitleAutoText, Position, ExcludeLabel)
である。
引数が五つもあるが、単に「図 1」、「図 2」と入れたいだけなら、「Label
」、「Position
」の二つを指定すれば十分だろう。
「Label
」は、「図 1」の「図」の指定、「Position
」は文字どおりキャプションの位置の指定に用いる。
こういうこと。
ちなみに、「Title
」を指定すると、
こんなふうになる。もちろん、引数Title
に「『アホの坂田』アルバムジャケット」という文字列を指定したのである。(今気づいたけど、「アルバム」じゃねえな。メンゴメンゴ。)
引数Labelの指定
ちょいとうっとうしいのが、引数Label
の指定である。
再び、『Word2013 developer docs』から引く。引数Label
の説明は次の通りである。
The caption label to be inserted. Can be a String or one of the WdCaptionLabelID constants. If the label has not yet been defined, an error occurs. Use the Add method with the CaptionLabels object to define new caption labels.
つまり、引数Label
の指定は文字列でもWdCaptionLabelID
の指定でもどちらでも良いが、文字列で指定した場合に、その文字列が「ラベル」として登録されていないものだったらエラーが出る、ということだ。
たとえば、
このような状態で、画像を選択して
Call Selection.InsertCaption("ち~んw")
を実行したとしても、「ち~んw」などというラベルは未登録なので、
エラーになるのである。
上記引用文中に「Use the Add method with the CaptionLabels object to define new caption labels.
」とあるように、未登録の文字列をラベルとして使用したければ、[CaptionLabels].Add
メソッドを用いて、CaptionLabels
コレクションに追加しておかねばならんのだ。
そこで、次のような対応が必要となる。
- 使用したいラベル(名)が
CaptionLabels
コレクション内にあるかどうかを調べる - コレクション内にあれば、そのインデックスを取得する
- なかったら、
CaptionLabels
コレクションに追加して、インデックス番号を取得する - 引数
Label
指定時には、[CaptionLabels].Item(index).Name
の形で指定する
およそ、このような手順である。
なかなか面倒である。
ラベルのインデックスを取得するFunction
まず、ラベルのインデックスを取得するFunctionを作成する。
リスト1
Private Function getCaptionLabelIndex( _ ByVal a_LabelName As String) As Long Dim ret As Long Dim captLabels As CaptionLabels Set captLabels = Application.CaptionLabels Dim i As Long For i = 1 To captLabels.Count '……(1)' If captLabels.Item(i).Name = a_LabelName Then ret = i GoTo ReturnValue End If Next Call captLabels.Add(a_LabelName) '……(2)' ret = captLabels.Count ReturnValue: getCaptionLabelIndex = ret End Function
(1)からの6行、
For i = 1 To captLabels.Count If captLabels.Item(i).Name = a_LabelName Then ret = i GoTo ReturnValue End If Next
は、登録済みのラベル調べ。
CaptionLabels
コレクション内のCaptionLabel
オブジェクトを一つづつ調べて、一致するものがあったらそのインデックスを返り値用変数ret
にぶち込んで、ReturnValue
に飛び、値を返す。
(1)のFor
ループを抜けたときは、引数a_LabelName
と一致するラベルがなかったということなので、(2)の
Call captLabels.Add(a_LabelName) ret = captLabels.Count
でCaptionLabels
コレクションに追加し、追加後のアイテム数(つまり、追加したアイテムのインデックス)を返り値用変数ret
にぶち込むようにしている。
選択した画像の下に図表番号を入れるマクロ
あとは、Selection.InsertCaption
を使うマクロにするだけ。
リスト2
Dim lblIndex As Long lblIndex = getCaptionLabelIndex(a_LabelName) Dim captLabels As CaptionLabels Set captLabels = Application.CaptionLabels Call Selection.InsertCaption(Label:=captLabels(lblIndex).Name, _ Position:=a_CaptionPosition)
プロシージャの一部分だけなので、少し補足。
a_LabelName
は、引数として受け取るラベルの文字列。「図」とか、そういうやつ。
a_CaptionPosition
は、引数として受け取るキャプションの位置を表す定数(WdCaptionPosition
列挙体)。
一旦、ラベル文字列をgetCaptionLabelIndex
に渡し、インデックス番号を取得してから、Selection.InsertCaption
の引数Label
の指定のために使っている。
使用例
挿入した画像を選択した状態で実行したときに、
- 段落スタイルを当て、
- 画像の四辺に囲み罫線を施し、
- 図表番号を挿入する
というマクロにしてみた。
リスト3
Public Sub ApplyInlineShapeSettingsMain() Dim ilShp As InlineShape If Selection.Type = wdSelectionInlineShape Then Set ilShp = Selection.InlineShapes(1) Else Exit Sub End If Call applyInlineShapeSettings("My図1", "図") '……(*)' End Sub Private Sub applyInlineShapeSettings( _ ByVal a_ParagraphStyleName As String, _ ByVal a_LabelName As String, _ Optional ByVal a_CaptionPosition As WdCaptionPosition _ = wdCaptionPositionBelow, _ Optional ByVal a_LineStyle As MsoLineStyle = msoLineSingle, _ Optional ByVal a_LineWeight As Single = 1#) Call setBordersForFigure(msoLineSingle) Selection.Style = a_ParagraphStyleName Dim lblIndex As Long lblIndex = getCaptionLabelIndex(a_LabelName) Dim captLabels As CaptionLabels Set captLabels = Application.CaptionLabels Call Selection.InsertCaption(Label:=captLabels(lblIndex).Name, _ Position:=a_CaptionPosition) End Sub Private Sub setBordersForFigure( _ Optional ByVal LineStyle As MsoLineStyle = msoLineSingle, _ Optional ByVal LineWeight As Single = 1#) Dim ilShp As InlineShape If Selection.Type = wdSelectionInlineShape Then If Selection.InlineShapes.Count = 0 Then Exit Sub Set ilShp = Selection.InlineShapes(1) Else Exit Sub End If Dim tgtLnFormat As LineFormat Set tgtLnFormat = ilShp.Line With tgtLnFormat .Visible = msoTrue .Style = LineStyle .Weight = LineWeight End With End Sub Private Function getCaptionLabelIndex( _ ByVal a_LabelName As String) As Long Dim ret As Long Dim captLabels As CaptionLabels Set captLabels = Application.CaptionLabels Dim i As Long For i = 1 To captLabels.Count If captLabels.Item(i).Name = a_LabelName Then ret = i GoTo ReturnValue End If Next Call captLabels.Add(a_LabelName) ret = captLabels.Count ReturnValue: getCaptionLabelIndex = ret End Function
(*)のところに出てくる「My図1
」というのは、個人的に設定しているスタイルの名前。
挿入した画像を選択して、リスト3を実行すると、
こうなる。
めっちゃ便利!
おわりに
これからも、面倒な作業をマクロ化したい。WordのVBAもなかなか面白いですよ。
追記
単に図表番号を追加するだけのメソッドを追加しました。
リスト4
Public Sub SetCaption(Optional ByVal a_LabelName As String = "図", _ Optional ByVal a_Position As WdCaptionPosition _ = wdCaptionPositionBelow) Dim lblIndex As Long lblIndex = getCaptionLabelIndex(a_LabelName) Dim captLabels As CaptionLabels Set captLabels = Application.CaptionLabels '図表番号を挿入する' Call Selection.InsertCaption(Label:=captLabels(lblIndex), _ Position:=a_Position) End Sub