テキストボックス挿入の自動化(Word)
表題のとおり、Wordの文書内にテキストボックスを挿入する作業を自動化したくなったので、やってみた。
きっかけとお題
きっかけ
文字ばっかりのPowerPointスライドを図として挿入するのに、画像で入れてしまったら、文字列の検索が利用できず、不便なので、テキストボックスで再現して挿入しようと思った。
お題
すると、次のような作業が発生することになる。
- テキストボックスを挿入する
- 枠線を設定する
- テキストボックス内の段落書式を設定する
- テキストボックス自体に段落スタイル(図用)を適用する
- テキストボックスの寸法(横幅)を決める
- 図表番号を設定する
ざっとこんな感じ。まあ、テキストボックスの複製自体は、一つ作っておけば、それをたとえば[Ctrl]+ドラッグで次のやつが作れるんだけれど、図表番号を挿入することを考えると、大した回数発生しない作業とはいえめんどくさい。
そこで、男坂WordVBAの登場ですよ!
要するに、上の作業を1クリックでやりたいわけです。
テキストボックスを挿入するマクロ
まずは、コードを掲載。
リスト1
Option Explicit Private Const FIGURE_STYLE_1 As String = "My図1" '……(1)' Private Const TEXTBOX_STYLE_1 As String = "MyTextBox1" Private Const TEXTBOX_STYLE_2 As String = "MyTextBox2" Private Const TEXTBOX_WIDTH As Single = 419.5276 '148ミリ' Private Const TEXTBOX_HEIGHT As Single = 204.0945 '72ミリ' Private Const TEXTBOX_MARGIN As Single = 11.33858 '4ミリ' Public Sub InsertInlineTextBox() Dim tgtDoc As Document '……(2)' Set tgtDoc = ActiveDocument Dim tb As Word.Shape Set tb = tgtDoc.Shapes.AddTextbox( _ Orientation:=msoTextOrientationHorizontal, _ Left:=0, Top:=0, _ Width:=TEXTBOX_WIDTH, _ Height:=TEXTBOX_HEIGHT) tb.WrapFormat.Type = wdWrapInline '……(3)' With tb '……(4)' With .Line '……(5)' .Visible = msoTrue .Weight = 1 .Style = msoLineSingle .ForeColor = vbBlack End With With .TextFrame '……(6)' .TextRange.Style = TEXTBOX_STYLE_1 .MarginTop = TEXTBOX_MARGIN .MarginBottom = TEXTBOX_MARGIN .MarginLeft = TEXTBOX_MARGIN .MarginRight = TEXTBOX_MARGIN End With End With Selection.Style = FIGURE_STYLE_1 '……(7)' End Sub
まず、(1)からの6行(空行除く)、
Private Const FIGURE_STYLE_1 As String = "My図1" Private Const TEXTBOX_STYLE_1 As String = "MyTextBox1" Private Const TEXTBOX_STYLE_2 As String = "MyTextBox2" Private Const TEXTBOX_WIDTH As Single = 419.5276 '148ミリ' Private Const TEXTBOX_HEIGHT As Single = 204.0945 '72ミリ' Private Const TEXTBOX_MARGIN As Single = 11.33858 '4ミリ'
これは、後のプロシージャ中で使う定数。
「My図1
」とか、「MyTextBox1
」、「MyTextBox2
」は、全部自作の段落スタイル名。
「TEXTBOX_WIDTH
」、「TEXTBOX_HEIGHT
」、「TEXTBOX_MARGIN
」は、寸法にかかわる値を定数化。
Wordを直接操作するときはミリ単位なんだけれど、VBAのメソッドではポイント単位の指定でわかりにくいので、Word.MillimetersToPoints
メソッドで変換した値を定数として設定している。
次に、(2)からの8行(実質4行)、
Dim tgtDoc As Document Set tgtDoc = ActiveDocument Dim tb As Word.Shape Set tb = tgtDoc.Shapes.AddTextbox( _ Orientation:=msoTextOrientationHorizontal, _ Left:=0, Top:=0, _ Width:=TEXTBOX_WIDTH, _ Height:=TEXTBOX_HEIGHT)
で、ひとまずテキストボックスを挿入。
アクティブなドキュメントを変数「tgtDoc
」にぶち込み、[Document].Shapes
(コレクション)オブジェクトのAddTextBox
メソッドを使う。
「行内」に配置したいのだが、[Document].InlineShapes
(コレクション)オブジェクトには、AddTextBox
メソッドがないので、仕方なくこうしている。
つまり、一旦位置を指定している。(引数Left
とTop
に0
を指定。)
引数Width
とHeight
は、文字どおりテキストボックスの幅と高さ。ここでは先に値を定めた定数をそれぞれ渡している。
(3)の
tb.WrapFormat.Type = wdWrapInline
では、tb
つまり、Shape
オブジェクトのWrapFormat
プロパティからWrapFormat
オブジェクトを取得し、そのType
プロパティにwdWrapInline
という値を設定している。
ちなみに、wdWrapInline
は、WdWrapType
列挙体のメンバ。
これで、一旦左上端に設置されたテキストボックスの配置が「行内」になる。
(4)からの15行、
With tb With .Line '……(5)' .Visible = msoTrue .Weight = 1 .Style = msoLineSingle .ForeColor = vbBlack End With With .TextFrame '……(6)' .TextRange.Style = TEXTBOX_STYLE_1 .MarginTop = TEXTBOX_MARGIN .MarginBottom = TEXTBOX_MARGIN .MarginLeft = TEXTBOX_MARGIN .MarginRight = TEXTBOX_MARGIN End With End With
は、テキストボックス自体の書式設定と、テキストボックス内の書式設定。
こういうふうにまとめて書ける、というのはVBAのいいところ。
まず、(5)からの6行、
With .Line .Visible = msoTrue .Weight = 1 .Style = msoLineSingle .ForeColor = vbBlack End With
[Shape].Line
プロパティを参照してLine
オブジェクトを取得。その各プロパティを設定している。要するに、テキストボックス自体の枠線の調整である。
(6)からの7行、
With .TextFrame .TextRange.Style = TEXTBOX_STYLE_1 .MarginTop = TEXTBOX_MARGIN .MarginBottom = TEXTBOX_MARGIN .MarginLeft = TEXTBOX_MARGIN .MarginRight = TEXTBOX_MARGIN End With
では、今度は[Shape].TextFrame
プロパティを参照してTextFrame
オブジェクトを取得。その各プロパティを設定している。
まず、TextRange
プロパティを参照してTextRange
オブジェクトを取得。そのStyle
プロパティに、適用したいスタイル名を設定している。当然、当該文書にそのスタイル(この場合は、定数TEXTBOX_STYLE_1
の中身、すなわち「MyTextBox1」スタイル。)が存在しなかったら実行時エラーになる。
残りの四つ(「Margin~
」)は、テキストボックス内のマージンの設定。
すでに設定済みの定数で設定。
最後に、(7)の
Selection.Style = FIGURE_STYLE_1
で、カーソル位置(つまり、テキストボックスが挿入された段落。)にスタイルを適用する。もちろん、この場合も定数FIGURE_STYLE_1
で指定したスタイルが文書に存在しなければ実行時エラーになる。
図表番号を付加するマクロ
これについては、コチラをどうぞ。
完成したマクロ
リスト2
Private Sub setTextBoxMain() Call TextBoxUtil.InsertInlineTextBox '……(1)' Call Selection.MoveRight(wdCharacter, 1, wdMove) '……(2)' Call Selection.InsertAfter(Chr(13)) Call UsefulMacros.SetCaption("図", wdCaptionPositionBelow) '……(3)' End Sub
(1)の
Call TextBoxUtil.InsertInlineTextBox
で、まずはテキストボックスを文書内に挿入する。
TextBoxUtil
というのは、リスト1のInsertInlineTextBox
メソッドを書いた標準モジュールの名前。
(2)からの2行、
Call Selection.MoveRight(wdCharacter, 1, wdMove) Call Selection.InsertAfter(Chr(13))
(1)の直後の段階では、カーソルがテキストボックスの左側にあるので、
(2)からの2行、
Call Selection.MoveRight(wdCharacter, 1, wdMove) '……(2)' Call Selection.InsertAfter(Chr(13))
でカーソルを一つ右に動かし、新しい段落を追加する。
最後に(3)の
Call UsefulMacros.SetCaption("図", wdCaptionPositionBelow)
で図表番号を追加。
「UsefulMacros
」というのも、自作の標準モジュール名。SetCaption
メソッドはその中にある。(そろそろ「UsefulMacros
」モジュールから切り離さないといけないと思っている。)SetCaption
メソッドのコードはコチラをどうぞ。
全部実行すると、
こうなる。
ちなみに、PDF化した後でも、
ちゃんと検索に引っかかる。ありがたい。
おわりに
Wordのマクロづくりは、楽しいなあ。