テキストで作成した議事録をWordに取り込んだ後、フォーマットを整形するVBAを作成してみた(その2)テーブルの追加

前回、Word VBAを利用して文字の検索やアラインメント、文字の修飾などを実施しました。

今回は、テーブル(表)を作成し、その中に日時や場所、参加者を入れ込んでみたいと思います。

1.処理イメージ

元となるデータのイメージは以下の通りです。
テキストデータをWordに取り込み、なんの修飾もしていない状態です。

元データのイメージ

また、完成形のイメージは以下の通りです。
タイトルの下にテーブルを作成し、その中に「日時」「場所」「参加者」の情報を移動させます。

VBAで加工後のデータイメージ

2.VBAのプログラム説明

ここでは前回の(その1)から変更した部分を中心に説明していきます。
前回同様、初心者なのでプログラムがダサいのはおおめに見てください。

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)

<解説>
最初の3行で変数を定義し、その中の一つ 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の部分で3×2のテーブルを作成し、その後、それぞれの行の最初の列に「日時」「場所」「参加者」の文字を書き込んでいます。

With Selection.Find
    .Text = "日時:"
    .Wrap = wdFindContinue
    .Execute
'    Selection.Font.Bold = True
End With

' forward cursor 1 charactor
Selection.Move wdCharacter, 1

<解説>
最初のfind処理で”日時:”のところにカーソルが来ているはず?なので、その後のSelection.Moveのところで1文字分カーソルを進ませています。
なぜ1文字でよいのかよくわかっていませんが、こうするとうまくいきました。(笑

' 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マクロ(2))
https://www.wordvbalab.com/code/11726/