挿入した画像に図表番号を挿入するマクロ(Word)

文書に挿入した画像にマクロで図表番号を付ける(Word)

f:id:akashi_keirin:20210327105521j:plain

最近、やたらマニュアルの類を作成している。

スクリーンショット等の画像を貼り付けた文書を作成することがやたら多くなったのだが、いちいち図表番号を入れるのが面倒になってきた。

……となると、当然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」は文字どおりキャプションの位置の指定に用いる。

f:id:akashi_keirin:20210327105526p:plain

こういうこと。

ちなみに、「Title」を指定すると、

f:id:akashi_keirin:20210327105528p:plain

こんなふうになる。もちろん、引数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の指定でもどちらでも良いが、文字列で指定した場合に、その文字列が「ラベル」として登録されていないものだったらエラーが出る、ということだ。

たとえば、

f:id:akashi_keirin:20210327105532p:plain

このような状態で、画像を選択して

Call Selection.InsertCaption("ち~んw")

を実行したとしても、「ち~んw」などというラベルは未登録なので、

f:id:akashi_keirin:20210327105535p:plain

エラーになるのである。

上記引用文中に「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を実行すると、

f:id:akashi_keirin:20210327105538g:plain

こうなる。

めっちゃ便利!

おわりに

これからも、面倒な作業をマクロ化したい。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