挿入した画像に図表番号を挿入するマクロ（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("ち～んｗ")

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

エラーになるのである。

上記引用文中に「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を作成する。

リスト１

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を使うマクロにするだけ。

リスト２

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の指定のために使っている。

使用例

挿入した画像を選択した状態で実行したときに、

• 段落スタイルを当て、
• 画像の四辺に囲み罫線を施し、
• 図表番号を挿入する

というマクロにしてみた。

リスト３

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」というのは、個人的に設定しているスタイルの名前。

挿入した画像を選択して、リスト３を実行すると、

こうなる。

めっちゃ便利！

おわりに

これからも、面倒な作業をマクロ化したい。WordのVBAもなかなか面白いですよ。

追記

単に図表番号を追加するだけのメソッドを追加しました。

リスト４

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

【速報】シェイプを選択しているとVBEでショートカットキーが使えなくなる

【速報】シェイプを選択しているとVBEでショートカットキーが使えなくなる

ちょっとした覚書。常識だったらすまん。

Wordの編集画面でシェイプを選択しているとVBEでショートカットキーが使えない

もう標題の通り。

このような、

Wordに貼り付けた画像に、枠線を施したり、段落スタイルを当てたり、図表番号を挿入したりするマクロを書いているときに、しばしばショートカットキーが効かない、という現象に悩まされたのだった。

再起動したら、ショートカットキーが効くときもあれば、効かないときもある。

レジストリの初期化してみても同じ。

「なんやねんこれ……」と困り果てていたが、原因は実にあほらしいものであった。

大事なことなので、強調しておきます。

Wordの編集画面でシェイプが選択されているときは、VBE上でショートカットキーが効きません！

[ F2 ]や[ F8 ]はおろか、[ Ctrl ]＋[ V ]やら[ Ctrl ]＋[ C ]、[ Ctrl ]＋[ J ]にいたるまで根こそぎ使えません。不便なことこの上なしです。

そういえば、シェイプ選択時は、「マクロの記録」も使えないんでしたな。

おわりに

ぐぐってみても、それらしいページにはヒットしなかったので、あまりこの現象に悩まされる人っていないのかな？

まあ、これが誰かの役に立ってくれたら幸いです。

列の最終行を求めるアレはなぜわかりにくいのか（Excel）

「[Worksheet.]Cells([Worksheet.]Rows.Count, 1).End(xlUp).Row」はなぜわかりにくいのか

任意の列（標題の場合はA列）の下端のセルの行番号を求めるおなじみのコード。

ときどき、「なかなか覚えられねえ！」という文脈で話題になるので、ちょっと考えてみた。

なぜ「覚えられねえ」のか

これは、端的に言ってたぶん〝理解していないから〟だと思う。

人間、理解したものはなかなか忘れないものだが、理解を伴わずにただ覚えているだけだと、忘れるのも早いように思う。

そうじゃない人もいるかも知れんが。

なぜ「理解」できないのか

これは、端的に言って

[Worksheet.]Cells([Worksheet.]Rows.Count, 1).End(xlUp).Row

という〝式〟（でええんか？）が、端的に〝わかりにくい〟からであろう。

なんせ、

①シートの一番下にあるセルを取得して、②そのセルから上方向に空白でないセルに突き当たったところのセルを取得して、③そのセルの行番号を取得する

というだけでも相当ややこしいのに、さらに「①」の「シートの一番下にあるセル」を指定するために、「シートの一番下」の行番号を取得せねばならず、そのために

④シートの行の総数（つまり「「シートの一番下」の行番号」と同じ数値）を取得している

という、めちゃくちゃややこしい手順を１行で書く、という暴挙を敢えてしているからである。

可能な限り分けて書く

求める手順

〝シート上のＡ列の一番下の空白でないセルの行番号〟を求める手順は以下の通り。

• Ａ列の一番下のセル（bottomCell）を取得する
• そのセルにカーソルを置いて、［Ctrl］＋［ ↑ ］を押してたどり着くセル（endCell）を取得する
• そのセルの行番号（endRow）を取得する

上記、「bottomCell」、「endCell」、「endRow」は、それぞれ後のコード内で使う変数名。

コード化

上記の手順をVBAのコード化する。

リスト１

Private Sub testEndRow()
  'Ａ列を表す定数'
  Const COLUMN_A As Long = 1

  'アクティブシートを変数にセット'
  Dim tgtSh As Worksheet
  Set tgtSh = ActiveSheet

  '一番下のセルの行番号'
  Dim MAX_ROW_NUM As Long
  MAX_ROW_NUM = tgtSh.Rows.Count
  
  'Ａ列の一番下のセル（bottomCell）を取得'
  Dim bottomCell As Range
  Set bottomCell = tgtSh.Cells(MAX_ROW_NUM, COLUMN_A)
  
  'bottomCellから上方に移動し、空白でないセルに突き当たったところの'
  'セル（endCell）を取得                                           '
  Dim endCell As Range
  Set endCell = bottomCell.End(xlUp)
  
  'endCellの行番号（endRow）を取得'
  Dim endRow As Long
  endRow = endCell.Row
  
  'イミディエイトに表示'
  Debug.Print endRow
End Sub

アクティブシートのＡ列の空白でない一番下のセルの行番号を取得して、イミディエイトに表示するだけのコード。

Dim tgtSh As Worksheet
Set tgtSh = ActiveSheet

Dim endRow As Long
endRow = tgtSh.Cells(tgtSh.Rows.Count, 1).End(xlUp).Row

と、このように書くよりは、よほど理解しやすいのではなかろうか。

おわりに

リスト１に示したように、オブジェクトや値を取得するごとに変数に格納する、というやり方で初心者向けに紹介すれば、

ただ覚えるだけのもの

ではなくなるのではないか、と思う。

参考

たとえば、この状態（A5セルにカーソルがある。）で、［Ctrl］＋［ ↓ ］を押すと、

こうなる。

これが、〝Ａ列の一番下のセル〟。

この状態（A1048576セルにカーソルがある。）で、［Ctrl］＋［ ↑ ］を押すと、

こうなる。

画像に枠線を施すマクロの書き換え（Word）

画像に枠線を施すマクロの書き換え

前回

akashi-keirin.hatenablog.com

枠線を消すマクロで、[InlineShape].Lineプロパティ（＝LineFormatオブジェクト）を用いたので、枠線を施す方も[InlineShape].Lineプロパティを用いる方法に書き換える。

akashi-keirin.hatenablog.com

このときのリスト１を書き換えるということ。

書き換えたコード

リスト１

Public Sub SetBordersForFigureMain()
  Call setBordersForFigure
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  '……(1)'
  Set tgtLnFormat = ilShp.Line
  With tgtLnFormat               '……(2)'
    .Visible = msoTrue
    .Style = LineStyle
    .Weight = LineWeight
  End With
End Sub

(1)からの7行

Dim tgtLnFormat As LineFormat
Set tgtLnFormat = ilShp.Line
With tgtLnFormat               '……(2)'
  .Visible = msoTrue
  .Style = LineStyle
  .Weight = LineWeight
End With

は、別に

With ilShp.Line                '……(2)'
  .Visible = msoTrue
  .Style = LineStyle
  .Weight = LineWeight
End With

と書いてもかまわない。

しかしながら、「LineFormatオブジェクトを操作しておるのだ！」という感じを出すために、あえてこうしている。大阪府の吉村知事が、〝やってる感〟を出すために「いつ仕事してんのかわからんぐらいテレビに出まくって」いるのと同じである。

(2)の

With ilShp.Line
  .Visible = msoTrue
  .Style = LineStyle
  .Weight = LineWeight
End With

では、取得したLineFormatオブジェクトのうち、Visible、Style、Weightの三つのプロパティのみ設定。

これらは、それぞれ

こいつらに対応している（と思う。）。

使ってみる

バッチリ。

おわりに

これで、枠線を施すマクロと枠線を削除するマクロが、きっちり対応しました。

画像の囲み線を消すマクロ（Word）

画像の囲み線を消すマクロ（Word）

前回

akashi-keirin.hatenablog.com

の最後のところで、

逆に、画像に施した枠線を除去するマクロの書き方がわからない。

誰か知っている人がいたら教えろ教えてください。

などと言っていたが、とりあえずやり方はわかった。

画像の枠線を消すマクロ

InlineShapeオブジェクトのLineプロパティ

InlineShapeオブジェクトには、Lineプロパティというものがあるらしい。

『Word 2013 developer docs』（Word2013のオフライン・ヘルプ）によると、

InlineShape.Line Property (Word)

Returns a LineFormat object that contains line formatting properties for the specified shape. Read-only.

Syntax

expression .Line

expression A variable that represents an InlineShape object.

ということらしい。

Lineプロパティという名前だが、Lineオブジェクトを返すわけではなく、あくまでもLineFormatオブジェクトを返す、ということ。

……となると、LineFormatオブジェクトについても調べておかざるを得ない。

LineFormatオブジェクトとは

これまた、『Word 2013 developer docs』によると、

LineFormat Object (Word)

Represents line and arrowhead formatting. For a line, the LineFormat object contains formatting information for the line itself; for a shape with a border, this object contains formatting information for the shape's border.

とのこと。

「a shape with a border」というのは、まさにドキュメント内に挿入した画像のことなので、こいつに含まれている「formatting information for the shape's border」をいじくってやれば、囲み線を消すことができるはずだ。

ちなみに、LineFormatオブジェクトのメンバは、

この通り。めっちゃ多い。

境界線を消すには

境界線を消すためには、LineFormatオブジェクトのVisibleプロパティをどうにかしたらよさげ。

みたび『Word 2013 developer docs』によると、

LineFormat.Visible Property (Word)

True if the specified object, or the formatting applied to it, is visible. Read/write MsoTriState.

とのこと。

単にTrue / Falseの二値なのではなく、MsoTriStateという列挙体で設定するらしい。

『オブジェクト ブラウザー』で調べてみると、MsoTriState列挙体のメンバは、

• msoCTrue
• msoFalse
• msoTriStateMixed
• msoTriStateToggle
• msoTrue

となっている。

なんで、「Tri」なのに五つもの状態が決められているのかよくわからん（三つじゃねえのかよ。）し、「CTrue」っていうのもなんのことかようわからん。

それでも、VisibleプロパティをmsoFalseにしたら、囲み線を非表示にすることはできそうだ。

画像の囲み線を消すマクロのコード

……というわけで、コードをば。

リスト１

Public Sub RemoveBordersOfFigure()
  Dim ilShp As InlineShape
  If Selection.Type = wdSelectionInlineShape Then
    Set ilShp = Selection.InlineShapes(1)
  Else
    Exit Sub
  End If
  ilShp.Line.Visible = msoFalse
End Sub

ふむ。まっ　たく　簡　単　だ。

使ってみる

この状態で、画像を選択して、リスト１を実行する。

ちなみに、「図の書式設定」は、

この状態。

ほれ、この通り。囲み線が消えている。

「図の書式設定」も

万全。バッチリ。

おわりに

これで、画像入りのWordドキュメントの作成がはかどることでしょう。

めでたしめでたし。

印刷マクロでちょっとハマる（Word）

印刷マクロでちょっとハマる（Word）

フォルダ内にたくさんあるWordドキュメントの先頭ページだけを印刷する必要があって（どんな「必要」やねん。）、

ちょろっとマクロ書いて片付けるか！

と意気込んで始めたにもかかわらず、ちょっとハマったので、報告。

先頭ページだけを印刷するマクロ

先頭ページだけを印刷するには、[Document].PrintOutメソッドを用いたら楽勝だと思った。

リスト１

Private Sub test08()
  Dim tgtDoc As Document
  Set tgtDoc = ActiveDocument
  Call tgtDoc.PrintOut(Range:=wdPrintFromTo, From:=1, To:=1)
End Sub

PrintOutメソッドの引数RangeにwdPrintFromToを指定し、From、Toの両方に1を指定。

これで、ドキュメントの1ページ目から1ページ目、すなわち、先頭ページだけを印刷することができるはずだ。

実行

満を持してリスト１を実行してみる。すると、

な…なんだってー!!

あえなく実行時エラーになるのである。

原因は、

ここなのだが……。

おわりに

原因がわかるだろうか……？

私は公式のリファレンスを見るまで、結構な時間ハマりました……。

傍点マクロの改良（Word）

傍点マクロの改良

目次

• 傍点マクロのイマイチなところ
• 傍点マクロを改良する
• 使ってみる
• 終わりに

傍点マクロのイマイチなところ

akashi-keirin.hatenablog.com

このときに紹介した傍点マクロ。

便利だと思っていたが、ショートカットキーでサクッと使えるようになると、コロナの弱点が見えてきた。大阪府の吉村知事ばりに！

こいつをご覧ください。

おわかりだろうか。傍点を施した箇所が選択されたままなのである。

しかも！

続けて文字を入力すると、このようなみじめな状態になるのである！

これはめちゃくちゃ不便である！

……ではなくって、さあ改良だ！

傍点マクロを改良する

前回のリストを参考に再掲する。

リスト１

Public Sub AddEmphasisMain()
  Static hasShown As Boolean
  Call AddEmphasisMark
  If Not hasShown Then
    Debug.Print "ショートカット キーは、[Ctrl]+[Alt]+[@]や。"
    hasShown = True
  End If
End Sub

Public Sub AddEmphasisMark( _
  Optional ByVal EmphasisMarkType As WdEmphasisMark = _
                                     wdEmphasisMarkOverComma)
  Dim rng As Range
  Set rng = Selection.Range
  rng.EmphasisMark = EmphasisMarkType
End Sub

AddEmphasisMarkMainからAddEmphasisMarkメソッドを呼び出す形にしている。

AddEmphasisMarkメソッドには、傍点を打つことに専念してもらい、傍点を打った後の処理は、呼び出し側のAddEmphasisMarkMainでやることにする。

変更後のコードを示す。

リスト２

Public Sub AddEmphasisMain()
  Static hasShown As Boolean
  Call AddEmphasisMark
  If Not hasShown Then
    Debug.Print "ショートカット キーは、[Ctrl]+[Alt]+[@]や。"
    hasShown = True
  End If
  Call Selection.Collapse(wdCollapseEnd)    '……(1)'
  Selection.Font.EmphasisMark = wdEmphasisMarkNone  '……(2)'
End Sub

Public Sub AddEmphasisMark( _
  Optional ByVal EmphasisMarkType As WdEmphasisMark _
                                     = wdEmphasisMarkOverComma)
  Dim rng As Range
  Set rng = Selection.Range
  rng.EmphasisMark = EmphasisMarkType
End Sub

二箇所コードを追加している。

まず、(1)の

Call Selection.Collapse(wdCollapseEnd)

で選択箇所を潰し、(2)の

Selection.Font.EmphasisMark = wdEmphasisMarkNone

で現在カーソルのある箇所（傍点を施した文字列直後の位置）を傍点なしにする。

これだけ。

使ってみる

傍点を施したい箇所を選択して、ショートカットキーでマクロを起動してみる。

ふふふ。快適だ。

終わりに

こういう小さなマクロを作るのが、Wordの場合は特に面白いと思います。

関連記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com