前回、Word VBAを利用して文字の検索やアラインメント、文字の修飾などを実施しました。
今回は、テーブル（表）を作成し、その中に日時や場所、参加者を入れ込んでみたいと思います。
１．処理イメージ
元となるデータのイメージは以下の通りです。
テキストデータをWordに取り込み、なんの修飾もしていない状態です。
また、完成形のイメージは以下の通りです。
タイトルの下にテーブルを作成し、その中に「日時」「場所」「参加者」の情報を移動させます。
２．VBAのプログラム説明
ここでは前回の（その１）から変更した部分を中心に説明していきます。
前回同様、初心者なのでプログラムがダサいのはおおめに見てください。
Option Explicit
Sub editMinuts()
Dim d_tbl As Table
Dim d_exc As String
Dim d_txt As String
' Chr(10): Line Feed, Chr(13): Carriage Return
d_exc = Chr(10) & Chr(13)
With Selection.Find
.Text = "2022."
.MatchByte = True
.Wrap = wdFindContinue
.Execute
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
End With
With Selection.Find
.Text = "議事録"
.Wrap = wdFindContinue
.Execute
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
' 1 line forward
Selection.Move wdLine, 1
' insert return charactor
Selection.TypeParagraph
' 1 line forward
Selection.Move wdLine, 1
' create table
Set d_tbl = ActiveDocument.Tables.Add(Selection.Range, 3, 2, wdWord9TableBehavior)
' insert charactor into table
d_tbl.Cell(1, 1).Select
Selection.TypeText Text:="日時"
d_tbl.Cell(2, 1).Select
Selection.TypeText Text:="場所"
d_tbl.Cell(3, 1).Select
Selection.TypeText Text:="参加者"
' find date&time charator
With Selection.Find
.Text = "日時："
.Wrap = wdFindContinue
.Execute
' Selection.Font.Bold = True
End With
' forward cursor 1 charactor
Selection.Move wdCharacter, 1
' select charactor from cursor to line end
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveEndWhile Cset:=d_exc, Count:=wdBackward
' get charactor from cursor to line end
d_txt = Selection.Text
' check d_txt contents
'MsgBox d_txt
Selection.Sentences(1).Delete
' insert d_txt into d_tbl
d_tbl.Cell(1, 2).Select
Selection.TypeText Text:=d_txt
' find place charator
With Selection.Find
.Text = "場所："
.Wrap = wdFindContinue
.Execute
' Selection.Font.Bold = True
End With
' forward cursor 1 charactor
Selection.Move wdCharacter, 1
' select charactor from cursor to line end
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveEndWhile Cset:=d_exc, Count:=wdBackward
' get charactor from cursor to line end
d_txt = Selection.Text
' check d_txt contents
'MsgBox d_txt
Selection.Sentences(1).Delete
' insert d_txt into d_tbl
d_tbl.Cell(2, 2).Select
Selection.TypeText Text:=d_txt
' find attendance charator
With Selection.Find
.Text = "参加者："
.Wrap = wdFindContinue
.Execute
' Selection.Font.Bold = True
End With
' forward cursor 1 charactor
Selection.Move wdCharacter, 1
' select charactor from cursor to line end
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveEndWhile Cset:=d_exc, Count:=wdBackward
' get charactor from cursor to line end
d_txt = Selection.Text
' check d_txt contents
'MsgBox d_txt
Selection.Sentences(1).Delete
' insert d_txt into d_tbl
d_tbl.Cell(3, 2).Select
Selection.TypeText Text:=d_txt
With Selection.Find
.Text = "アクションアイテム："
.Wrap = wdFindContinue
.Execute
Selection.Font.Bold = True
End With
With Selection.Find
.Text = "次回："
.Wrap = wdFindContinue
.Execute
Selection.Font.Bold = True
End With
Selection.Move wdLine, 1
Selection.InsertBreak Type:=wdPageBreak
With Selection.Find
.Text = "内容："
.Wrap = wdFindContinue
.Execute
Selection.Font.Bold = True
End With
End Sub
以下、ポイントを解説していきます。
Dim d_tbl As Table Dim d_exc As String Dim d_txt As String ' Chr(10): Line Feed, Chr(13): Carriage Return d_exc = Chr(10) & Chr(13)
＜解説＞
最初の３行で変数を定義し、その中の一つ d_exc にLine Feed と Carriage Returnキャラクタを設定しています。
これは後ほど、カーソル位置から行末までの文字を選択する際に、改行の制御文字を含まない為の処理となっています。
' create table Set d_tbl = ActiveDocument.Tables.Add(Selection.Range, 3, 2, wdWord9TableBehavior) ' insert charactor into table d_tbl.Cell(1, 1).Select Selection.TypeText Text:="日時" d_tbl.Cell(2, 1).Select Selection.TypeText Text:="場所" d_tbl.Cell(3, 1).Select Selection.TypeText Text:="参加者"
＜解説＞
ActiveDocument.Tables.Addの部分で３×２のテーブルを作成し、その後、それぞれの行の最初の列に「日時」「場所」「参加者」の文字を書き込んでいます。
With Selection.Find
.Text = "日時："
.Wrap = wdFindContinue
.Execute
' Selection.Font.Bold = True
End With
' forward cursor 1 charactor
Selection.Move wdCharacter, 1
＜解説＞
最初のfind処理で”日時：”のところにカーソルが来ているはず？なので、その後のSelection.Moveのところで１文字分カーソルを進ませています。
なぜ１文字でよいのかよくわかっていませんが、こうするとうまくいきました。（笑
' select charactor from cursor to line end Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.MoveEndWhile Cset:=d_exc, Count:=wdBackward
＜解説＞
Selection.EndkeyのExtend:=wdExtendで選択範囲を維持しながら、Unit:=wdLineで行末に移動しています。
また、Selection.MoveEndWhile Cset:=d_excにて、先ほどd_excに設定したキャラクタが右隣に来るまで移動させています。
' get charactor from cursor to line end d_txt = Selection.Text ' check d_txt contents 'MsgBox d_txt Selection.Sentences(1).Delete ' insert d_txt into d_tbl d_tbl.Cell(1, 2).Select Selection.TypeText Text:=d_txt
＜解説＞
d_txt = Selection.Textにて、現在選択されている範囲の文字をd_txtに取り込み、Selection.Sentences(1).Deleteでその行を消し去った後、d_txtの内容をテーブルのセル（1,2）にセットしています。
どうでしょう、なんとなくきちんとした議事録っぽくなってきた感じがしませんか？
次に機会があれば「アクションアイテム：」のところで複数行を一気に選択して表に入れる処理を作成できればと思っています。
参考サイト：
・インストラクターのネタ帳（Word VBAで表を作成・挿入する）
https://www.relief.jp/docs/word-vba-add-a-table.html
・インストラクターのネタ帳（Word VBAでカーソルを行末に移動する）
https://www.relief.jp/docs/word-vba-selection-endkey-wdline.html
・みんなのワードマクロ（【コード】選択範囲を広げるWordマクロ（２））
https://www.wordvbalab.com/code/11726/
