投稿者: kurita

前回、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/

お仕事で議事録を作成するときに、まずはその場でメモを作成し、あとでWordに清書することがあると思います。

でも、メモからWordに取り込んで書式を整えるのって、結構時間がかかる割に、あまり価値のある作業ではないですよね。

そこで、今回は時短のために、テキストから取り込んだデータのフォーマットを自動的に整えるWord VBAを作成してみました。

１．変換前のWordデータ・イメージ

こちらはテキストの内容をWordに取り込んだ直後のイメージです。見た目は考えず、とりあえず打ち込んでいくとこんな感じになっていると思います。

２．変換後のWordデータ・イメージ

１．の殴り書き状態からVBAを利用することで、以下の状態にフォーマットを整えさせます。

＜解説＞
１行目の作成日付を右寄せする。
２行目の「議事録」をタイトルとしてセンタリングする。
３行目〜９行目までの「日時：」「場所：」「参加者：」「アクションアイテム：」「次回：」を太字にする。

＜解説＞
１０行目を次ページにした上で「内容：」を太字にする。

３．変換用VBA

そして以下がフォーマット整型用のVBAになります。（素人なので書き方がダサくてすみません。）

Option Explicit

Sub editMinuts()

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

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

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

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

４．VBAの解説

それではポイントを少し解説しておきます。
なお、かなりアバウトに勉強しながら書いているので、雰囲気で説明している部分があります。
正確にはマイクロソフトの公式サイトなどを読んでください。

最初の方の３〜１０行目あたり

With Selection.Find
    .Text = "2022."
    .MatchByte = True
    .Wrap = wdFindContinue
    .Execute
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
End With

＜解説＞
.Text = “2022.”：データの中から”2022.”を検索します。
.MatchByte = True：上記”2022.”に完全に一致する文字を検索します。（全角などはヒットしないようにしています）
.Wrap = wdFindContinue：１つ見つかっても、次を見つけにいきます。
.Execute：検索を実行します。
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight：見つかったら、それを含む行を右寄せします。

下から８〜９行目あたり

Selection.Move wdLine, 1

Selection.InsertBreak Type:=wdPageBreak

＜解説＞
Selection.Move wdLine, 1：一つ手前の処理で「次回：」まで検索していますので、その下に改ページを入れる為、カーソルを１行進ませます。
Selection.InsertBreak Type:=wdPageBreak：改ページを挿入します。

今回は以上になりますが、今後時間があれば、Wordに表を入れるVBAなどを作成してみたいと考えています。