WordでMarkdownっぽいことをするマクロ（Word）
WordでMarkdownっぽいことをするマクロ（Word）
やりたいこと
- 先頭に
#を付けた段落には、「#」の数に応じた階層の「見出し」スタイルを当てる。 - その他の「標準」スタイルの段落には、「本文」のスタイルを当てる。
こういうことがしたい。
仕事柄、文章の資料を作成することが多い。下書き段階ではテキストエディタでぐりぐり書いていきたいのだが、見出しとかの表現がmachine-readableでなくていまいちだった。
「だったら、Markdown的に書けるようにしたらいいんじゃね？」と思って、冗談半分で作り始めたのがきっかけ。
今ではいろんな表現に対応した立派な〝インチキMarkdownマクロ〟になり、非常に重宝しているのだが、今回は「見出し」だけに対応した簡易ヴァージョンをご紹介、というわけ。
こんなコード
Documentオブジェクトを渡したら、その配下のParagraphsコレクションの要素であるParagraphオブジェクトを一つづつ調べ、先頭に「# 」があったら「#」の数に応じた「見出し」スタイルを、先頭に「# 」がなくて、なおかつ「標準」スタイルの段落なら、「本文」用のスタイルを当てる、というもの。
さっそくコードをお示ししよう。
リスト１
Public Sub SetHeaderStyle(ByVal a_Document As Document)
Dim tgtDoc As Document
Set tgtDoc = a_Document
Dim tgtPara As Paragraph
Dim tmpLen As Long
Dim tmpStr As String
Dim i As Long
Dim j As Long
For Each tgtPara In tgtDoc.Paragraphs
With tgtPara
With .Range
'「#」で始まらない段落は飛ばす。'
If .Characters.Item(1).Text <> "#" Then GoTo Continue
tmpLen = Len(.Text) - 1 '改段落文字分を引く。'
'2文字未満なら見出しのわけがないので飛ばす'
If tmpLen < 2 Then GoTo Continue
'見出しレベル9でも10字にしかならないので最大10字で切る。'
If tmpLen > 10 Then tmpLen = 10
tmpStr = Left(.Text, tmpLen)
'「# 」が含まれていなかったら飛ばす。'
If InStr(1, tmpStr, "# ") < 1 Then GoTo Continue
'先頭が〈「#」の連続＋半角スペース〉になっていたら見出し。'
For i = tmpLen To 2 Step -1 '……(*)'
If Left(tmpStr, i) = String(i - 1, "#") & " " Then
tgtPara.Style = "見出し " & CStr(i - 1)
For j = i To 1 Step -1
Call .Characters.Item(j).Delete
Next
End If
Next
End With
End With
Continue:
'見出しでない標準スタイルの段落には本文字下げスタイル。'
If tgtPara.Style = "標準" Then
tgtPara.Style = "My本文字下げ1" '……(**)'
End If
Next
End Sub
だいたい見ての通りなので、説明は省略。
ただし、「(*)」のところだけ簡単に説明しておく。
For i = tmpLen To 2 Step -1 '……(1)'
If Left(tmpStr, i) = String(i - 1, "#") & " " Then '……(2)'
tgtPara.Style = "見出し " & CStr(i - 1) '……(3)'
For j = i To 1 Step -1 '……(4)'
Call .Characters.Item(j).Delete
Next
End If
Next
まず、(1)の
For i = tmpLen To 2 Step -1
では、段落先頭から最大10まで（段落の文字数が、改段落マークを除いて10字未満なら、10よりも小さな数になる。）の数値を表す変数tmpLenを1づつ減じながらループする。
(2)の
If Left(tmpStr, i) = String(i - 1, "#") & " " Then
で、tmpStrに入っている文字列（段落先頭からtmpLen字分切り取った文字列。）を先頭からi字分切り取った文字列を調べる。
たとえば、iが4のときに、tmpStrの先頭i文字、つまり先頭4字が「### 」（#3個と半角スペース）だったら、見出しレベル3を適用すれば良いことになる。
(2)の条件式がTrueになると、(3)の
tgtPara.Style = "見出し " & CStr(i - 1)
で、当該の段落に「見出し」スタイルを適用する。
先の例でいうと、iが4のときには、見出しレベル「3」を適用するのだから、"見出し " & CStr(i - 1)とすれば、めでたく「見出し 3」という文字列を組み立てることができる。
あとは、(4)からの3行、
For j = i To 1 Step -1 '……(4)' Call .Characters.Item(j).Delete Next
で、見出しであることを表す「# 」を削除する。
コレクションの要素を削除すると、自動でインデックスが繰り上がる仕様なので、こうしないとおかしなことになる。
「削除はケツから！」は常識中の常識である！
ちなみに、(**)の
If tgtPara.Style = "標準" Then tgtPara.Style = "My本文字下げ1" End If
のところに出てくる「My本文字下げ1」というのは、私が勝手に作ったスタイルの名前。めちゃくちゃダサい名前にしてしまって、激しく後悔している。
使ってみる
原稿をテキストエディタで作って、Wordに貼り付ける。
次のリスト２を実行する。
リスト２
Private Sub test01() Dim tgtDoc As Document Set tgtDoc = ActiveDocument Call SetHeaderStyle(tgtDoc) End Sub
すると、一瞬で
こうなる。
ナビゲーション ウインドウも
この通り！
バッチリである！
おわりに
このほか、アンダーライン、太字強調、傍点、ルビ、引用、箇条書きに対応済み（ただし、箇条書きは1階層にしか対応していません。）なのですが、めちゃくちゃ便利です。
今回ご紹介した「見出し」対応だけでも十分便利だと思います。
段落罫線を気軽に追加する（Word）
段落罫線を気軽に追加する
段落罫線を追加するのはめんどくさい
文書に区切りの線を入れたいときがある。
たとえば、
こいつを、
こんなふうにしたいときである。
（あ。「そんなもん、ハイフン三つ連チャンで入力したらいいじゃねえか。タコ！」というツッコミはなしね。それでうまくいかなくて、段落罫線をいじるしかない場合を想定しているので。）
しかし、ただこれだけのことが異様にめんどくさい。
どのぐらいめんどくさいか、今からお目にかけよう。
「そんなもん、どーでもええわい。早よ、結論を言えや。」と言う人は、コチラをどうぞ。
段落罫線を追加する手順
段落罫線を追加する手順を示す。（各手順のカッコ内は、最低限必要なクリックの数／累計クリック数。）
まず、「デザイン」タブをクリックする。（1回／1回）
「ページ罫線」をクリックする。（1回／2回）
「罫線」タブをクリックする。（1回／3回）
「設定対象」ドロップダウンを展開し、「段落」を選択する。（2回／5回）
罫線の位置を設定し、［オプション］ボタンをクリックする。（2回／7回）
（線種や色、太さはデフォルトのまま、という場合。当然、これらを設定するとクリック数は増える。）
段落から罫線への距離を設定して、［OK］ボタンをクリックする。（1回／8回）
（もちろん、段落から罫線への距離をスピンボタンをクリックして設定すると、その回数に応じてクリック数は増える。画像だと「下」を「5」にしているので、4回クリックすることになる。）
で、最後に「線種とページ罫線と網かけの設定」ダイアログボックスの［OK］ボタンをクリックすることになるので、最低でも実に9回もクリックをしないと、段落罫線一つ追加できないのである。（段落から罫線への距離をデフォルトのままにしたら7回。）
これはめちゃくちゃめんどくさい。
そこで、VBAの出番なのである！
段落罫線を追加するFunction
次のようなFunctionを作った。
リスト１
Public Sub AddParagraphBorder( _
ByVal a_Paragraph As Paragraph, _
ByVal a_BorderType As WdBorderType, _
Optional ByVal a_LineStyle As WdLineStyle = wdLineStyleSingle, _
Optional ByVal a_LineWidth As WdLineWidth = wdLineWidth050pt, _
Optional ByVal a_Color As WdColor = wdColorAutomatic, _
Optional ByVal a_DistanceFrom As Long = 1)
Dim tgtPara As Paragraph
Set tgtPara = a_Paragraph
'a_DistanceFromが負の数だったら、「1」にする'
Dim distPts As Long
If a_DistanceFrom < 0 Then
distPts = 1
Else
distPts = a_DistanceFrom
End If
'元の罫線情報を取得しておく'
With tgtPara.Borders
'罫線への距離'
Dim distTop As Long: distTop = .DistanceFromTop
Dim distBottom As Long: distBottom = .DistanceFromBottom
Dim distLeft As Long: distLeft = .DistanceFromLeft
Dim distRight As Long: distRight = .DistanceFromRight
'罫線の種類・太さ・色'
With .Item(wdBorderTop)
Dim topStyle As WdLineStyle: topStyle = .LineStyle
Dim topWidth As WdLineWidth: topWidth = .LineWidth
Dim topColor As WdColor: topColor = .Color
End With
With .Item(wdBorderBottom)
Dim bottomStyle As WdLineStyle: bottomStyle = .LineStyle
Dim bottomWidth As WdLineWidth: bottomWidth = .LineWidth
Dim bottomColor As WdColor: bottomColor = .Color
End With
With .Item(wdBorderLeft)
Dim leftStyle As WdLineStyle: leftStyle = .LineStyle
Dim leftWidth As WdLineWidth: leftWidth = .LineWidth
Dim leftColor As WdColor: leftColor = .Color
End With
With .Item(wdBorderRight)
Dim rightStyle As WdLineStyle: rightStyle = .LineStyle
Dim rightWidth As WdLineWidth: rightWidth = .LineWidth
Dim rightColor As WdColor: rightColor = .Color
End With
End With
'指定された罫線の形態を上書きする'
Select Case a_BorderType
Case wdBorderTop
topStyle = a_LineStyle: topWidth = a_LineWidth
topColor = a_Color: distTop = distPts
Case wdBorderBottom
bottomStyle = a_LineStyle: bottomWidth = a_LineWidth
bottomColor = a_Color: distBottom = distPts
Case wdBorderLeft
leftStyle = a_LineStyle: leftWidth = a_LineWidth
leftColor = a_Color: distLeft = distPts
Case wdBorderRight
rightStyle = a_LineStyle: rightWidth = a_LineWidth
rightColor = a_Color: distRight = distPts
End Select
'罫線の形態を再セットする'
With tgtPara.Borders
.DistanceFromTop = distTop
.DistanceFromBottom = distBottom
.DistanceFromLeft = distLeft
.DistanceFromRight = distRight
With .Item(wdBorderTop)
If topStyle = wdLineStyleNone Then
Else
.LineStyle = topStyle: .LineWidth = topWidth
.Color = topColor
End If
End With
With .Item(wdBorderBottom)
If bottomStyle = wdLineStyleNone Then
Else
.LineStyle = bottomStyle: .LineWidth = bottomWidth
.Color = bottomColor
End If
End With
With .Item(wdBorderLeft)
If leftStyle = wdLineStyleNone Then
Else
.LineStyle = leftStyle: .LineWidth = leftWidth
.Color = leftColor
End If
End With
With .Item(wdBorderRight)
If rightStyle = wdLineStyleNone Then
Else
.LineStyle = rightStyle: .LineWidth = rightWidth
.Color = rightColor
End If
End With
End With
End Sub
こんな感じ。説明はめんどくさいから省略。
簡単に手順だけ示しておく。
- 元の段落罫線の状態を取得
- 引数で渡された箇所の罫線情報だけ上書きする
たったこれだけ。
こんなにカンタンになりました
カーソルのある段落の下に5ポイント離して罫線を引くマクロを作る。
リスト２
Public Sub AddParagraphBottomBorder()
Dim tgtDoc As Document
Set tgtDoc = ActiveDocument
Dim tgtPara As Paragraph
Set tgtPara = tgtDoc.Paragraphs( _
ParagraphUtil.GetParagraphIndex(Selection.Range))
Call ParagraphUtil.AddParagraphBorder(tgtPara, wdBorderBottom, _
wdLineStyleSingle, _
wdLineWidth050pt, _
wdColorAutomatic, 5)
End Sub
ちなみに、上掲コード中のGetParagraphIndexは、標準モジュールParagraphUtil内に書いた自作のメソッド。
一応、そのコードも載っけておく。
リスト３
Public Function GetParagraphIndex( _
ByVal a_Target As Range) As Long
Dim ret As Long
Dim rng As Range
Set rng = a_Target
rng.Start = 0
ret = rng.Paragraphs.Count
Dim pos As Long
pos = rng.End
'カーソルが全体の先頭にあるときは pos - 1 でエラーになる'
If pos = 0 Then GoTo ReturnValue
Dim char As String
char = rng.Parent.Range(pos - 1, pos).Text
'直前が改段落マークのときはカーソルが段落の先頭にある'
If char = Chr(13) Then
ret = ret + 1
End If
ReturnValue:
GetParagraphIndex = ret
End Function
要するに、
こいつの修正版。ちょっとぶさいくな修正結果だが。（エレガントな方法を知っている人がいたら教えろえてください。）
リスト２のマクロをクイック アクセス ツール バーに登録して、実行した様子が、
コチラ。
楽勝！
おわりに
こういう、〝通常の操作がメンドクサイやつをマクロ化する〟というのが、Wordの場合のVBAの使いどころなんじゃないかなあ、と思い始めています。
カーソルが段落の先頭にあると正しい段落インデックスが取得できない（Word）
カーソルが段落の先頭にあると正しい段落インデックスが取得できない
［Range］.Startプロパティと［Range］.［Paragraphs］.Countプロパティを用いる方法
Rangeオブジェクトの終端がある段落インデックスを取得する方法は、かつて
で紹介したことがある。
簡単に言うと、
RangeオブジェクトのStartプロパティを強引に「0」にすることにより、Rangeオブジェクトの始端をドキュメントの先頭にしてRangeオブジェクトを拡張。その中のParagraphsコレクションの数（Countプロパティで取得可能）を勘定する
というやり方である。
当時は、脳天気に「最初にこのアイディアを考えついたやつは天才だと思う。」などと喜んでいたものだ。
落とし穴があった！
ところが、「上手の手から水が漏る」のことば通り、先の方法には落とし穴があったのである！
落とし穴をお目にかけよう。
この通り、どう見てもカーソルは第4段落の先頭にある。したがって、Selection.Rangeが返すRangeオブジェクトは、第4段落の先頭を指し示すのである。
しかし！
リスト１
Public Function GetParagraphIndex( _
ByVal a_Target As Range) As Long
Dim ret As Long
a_Target.Start = 0
ret = a_Target.Paragraphs.Count
GetParagraphIndex = ret
End Function
このGetParagraphIndexメソッドに、Selection.Rangeを渡して実行すると、
この通り、「3」が返る〔＊〕のである！
これでは全然だめである！
＊
GetParagraphIndexメソッドは、Normal.dotmプロジェクトの標準モジュールParagraphUtilに書いてあるので、このような呼び出し方になっている。
検証：なんでこうなるのか
先のリスト１に、次の1行を付け加える。
リスト２
Public Function GetParagraphIndex( _
ByVal a_Target As Range) As Long
Dim ret As Long
a_Target.Start = 0
Call a_Target.Select '……(*)'
ret = a_Target.Paragraphs.Count
GetParagraphIndex = ret
End Function
a_TargetのStartプロパティを「0」にした直後、つまりa_Targetの始端をドキュメントの先頭まで拡張した直後に、Selectメソッドを実行して止めてみる。
確かに、第3段落目までしか選択されていない。
道理で「3」が返るわけである。
検証終わり。
おわりに
というわけで、カーソルが段落の先頭にある場合にも正しい段落インデックスを返すように、改修する必要があります。
いちおう、改修自体はしているのですが、なんとも不細工なやり方で、もっとスマートな方法はないものか、と思っています。
〈カーソルが段落先頭にあることを判定するスマートな方法〉を知っていたら教えろえてください。
RemovePersonalInformationプロパティというものがある（Word）
RemovePersonalInformationプロパティというものがある
結論だけ知りたければ、コチラをどうぞ。
前回の方法
文書の「作成者」とか「最終更新者」の情報を消す方法として、前回は、
こういう方法を紹介した。
しかし、これもあまり良い方法ではなかった。
たとえば、
こういうドキュメント（笑）があったとする。
ぱっと見はわからないが、実はこのドキュメントは、表題のところに
このように「タイトル」という文書情報（ドキュメントプロパティ）を「挿入」している。（で、「ヘッダー」のところにも同じように「タイトル」を「挿入」しているので、表題を変えたら「ヘッダー」も連動して変わるようになっている。
で、文書情報を見ると、
このとおり。非常に恥ずかしい状態である！
ここで、前回の方法を用いる。
リスト１
Private Sub test() Dim tgtDoc As Document Set tgtDoc = ActiveDocument Call tgtDoc.RemoveDocumentInformation(wdRDIDocumentProperties) End Sub
こいつを実行してやる。
すると、当然、
文書情報は消えている。
しかし！
おわかりだろうか。
「タイトル」という文書情報を挿入していた箇所が、ただの文字列に置き換わってしまっているのである！
これはいかん！
タンザニアのイカンガーである！
RemovePersonalInformationプロパティ
さて。
そうこうしているうちに、[Document].RemovePersonalInformationというプロパティを見つけた。
有名なのだろうか。
ぐぐってみた。
Document.RemovePersonalInformation プロパティ (Word)
True 場合は、Microsoft Word は、コメント、変更履歴、およびドキュメントの保存時に [プロパティ] ダイアログ ボックスからすべてのユーザー情報を削除します。 読み取り/書き込みが可能な Boolean です。
『Office VBA リファレンス』
なるほど。これなら日本語版でも意味がわかる。
やってみよう。
あっさり解決
リスト２
Private Sub test() Dim tgtDoc As Document Set tgtDoc = ActiveDocument tgtDoc.RemovePersonalInformation = True End Sub
こいつを、先のドキュメント（笑）をアクティヴにして実行！
(ﾟДﾟ)ﾊｧ?
上書き保存をしてやると、
ほれ、このとおり。
挿入した「タイトル」も生きておる！
ずばっと解決してしまった。
もちろん、これは真の解決ではないであろう。
旅はまだまだ続く……。
未完！
おわりに
とりあえず、
こいつも、早くも役目を終えてしまった。
用なし。
諸行無常！
RemoveDocumentInformationメソッドというものがある（Word）
RemoveDocumentInformationメソッドというものがある
RemoveDocumentInformationメソッド
知らなかった。
Documentクラスのメンバ一覧を「オブジェクト ブラウザー」様で見ていて見つけた。
有名なのだろうか……。
使ってみる
例によって、私がマイPCで文書を作成すると、
ドキュメントの「情報」として、非常に恥ずかしい情報がクレジットされてしまっている。
このドキュメントをアクティヴにした状態で、次のリスト１を実行してみる。
リスト１
Private Sub test() Dim tgtDoc As Document Set tgtDoc = ActiveDocument Call tgtDoc.RemoveDocumentInformation(wdRDIDocumentProperties) End Sub
すると、どうなるか。
実行結果
こうなるのである！
おわりに
[Document].RemoveDocumentInformationメソッドの引数には、WdRemoveDocInfoType列挙体のメンバを渡す。
今回は、「wdRDIDocumentProperties」を渡したのだが、メンバの中には、他にも「 wdRDIRemovePersonalInformation」など、非常に気になる名前のものがある。
こういうものも、今後きちんと調べておくべきだろう。
というわけで、早くも
コイツは役目を終えたのである！
諸行無常！
追伸
ちなみに、このたびの〝発見〟は、和風スパゲティのレシピ氏からのインスパイヤのおかげです。
VBA初心者のみなさん！ あるていど「オブジェクト」とか「プロパティ」ということばの意味がわかってきたら、「オブジェクト ブラウザー」様でいろんなクラスのメンバ一覧を眺めてみましょう！ きっと、大発見がありますよ！
たぶん、次のフレーズの意味がわかるようになったときが、「オブジェクト ブラウザー」様を眺めてみる一つの契機かも。
WorksheetオブジェクトのRangeプロパティがRangeオブジェクトを返す。
昔は、これ、何言ってんのか全然わかりませんでした。
文書の「作成者」を書き換える（Word）
文書情報を書き換える
BuiltInDocumentPropertiesプロパティ
私は、Microsoftアカウントを、実にふざけた名前で登録してしまっている。
だから、自宅のPCで作成したドキュメントをもとに、仕事で使うドキュメントを作成したときなんかには、「作成者」とか「最終更新者」のところに、非常に恥ずかしい名前が表示されてしまって困る。
まあ、そもそも「ファイル」タブをクリックして、「情報」を確認するような人は、わが業界にはほとんどいないので、バレることも滅多にないのであるが！
「作成者」を書き換える
「作成者」を表すDocumentPropertyオブジェクトを取得する
「作成者」を書き換えるには、まず、「作成者」を表すオブジェクトを取得せねばならない。
それは、DocumentPropertyオブジェクトである。
そして、それは[Document].BuiltInDocumentPropertiesプロパティから取得する。
簡単に言うと、
DocumentオブジェクトのBuiltInDocumentPropertiesプロパティから、BuiltInDocumentPropertiesコレクションオブジェクトを取得する！BuiltInDocumentPropertiesコレクションオブジェクトのItemプロパティから、「作成者」を司るDocumentPropertyオブジェクトを取得する！
こういうことである！
とりあえず、「オブジェクト ブラウザー」様によると、
ということなので、[Document].BuiltInDocumentPropertiesコレクションのItem(Index)プロパティで、「Index」に適当な値を渡してやればいい。
「作成者」の場合は、「"Author"」という文字列か、またはwdPropertyAuthor（WdBuiltInProperty列挙体のメンバ）を渡す。
そうすると、ItemプロパティがDocumentPropertyオブジェクトを返す、というしくみ。
DocumentPropertyオブジェクトのValueプロパティを書き換える
DocumentPropertyオブジェクトを取得しさえすれば、これは簡単。
Valueプロパティを書き換えるだけ。
リスト１
Private Sub test01()
Dim tgtDoc As Document
Set tgtDoc = ActiveDocument
tgtDoc.BuiltInDocumentProperties.Item("Author") = "TopSecret"
End Sub
「作成者」を「TopSecret」に書き換えるだけのマクロ。
こいつを、先の恥ずかしいドキュメントをアクティヴにして実行すると、
当然こうなる。
おわりに
これで、「作成者」欄に恥ずかしいアカウント名が刻印されたドキュメントが大量にあったとしても、簡単にクレンジングできる。
しかし、「最終更新者」はこの方法ではだめなんだよなあ……。
CharacterUnitFirstLineIndentプロパティ、おまえだったのか……（Word）
CharacterUnitFirstLineIndentプロパティ、おまえだったのか。いつもくりをくれたのは。
ついさきほど、
こんなことを書いたところだが、マルちゃん麺づくりばりにあっさり解決したので、報告。
CharacterUnitFirstLineIndentプロパティというものがある
テキトーにぐぐっていたら、
こんなのを見つけた。
コメント欄の「3.」に曰く、
通りすがりの者です。
もう解決済みかと思いますが、たまたま私も同じ問題に遭遇し悩んでおりましたので。
私の場合は、.CharacterUnitFirstLineIndent = 0 .FirstLineIndent = nとすることで設定値が反映されました。
上記の処理順が逆の場合や、CharacterUnitFirstLineIndentに0以外の値が設定されている場合はこちらが優先され、FirstLineIndentは変更できないような挙動でした。
ご参考になれば幸いです。
なにーーーー！ CharacterUnitFirstLineIndentだとーーー！
それもう、名前からしてモロに〝字数単位で指定している1行目のインデント〟のことじゃないっすかーーー！
コードの書き換え
で、前回のリスト1を次のように書き換える。
リスト１
Public Sub OffFirstLineIndent()
With Selection.ParagraphFormat
If .CharacterUnitFirstLineIndent <> 0 Then
.CharacterUnitFirstLineIndent = 0
End If
.FirstLineIndent = 0
End With
End Sub
もう、見てのとおり、CharacterUnitFirstLineIndentプロパティの値が「0以外の値」だったら「0」にしてから、FirstLineIndentプロパティの値を「0」にしてやるのだ！
うむ！ 万全である！
実行してみる
ははは！ 完璧ではないか！
おわりに
ichitnkさん、ありがとうございました！
