指定した文字列に傍点を施すWordマクロ

芦田宏直氏が、ブログ『芦田の毎日』上で、「シラバスとは何か ― コマシラバスはなぜ必要なのか」という超大作の論考を発表しておられる。

氏のツイート（@jai_an）によると、2019/07/06時点で11万字overとのこと。

読むにあたっての困難

読まねば、とは思ったものの、何せ11万字overの論考である。

素人ゆえ大した読解力もない私が、PCやタブレットの画面上で読むのはつらい。

とりあえず、Wordとか一太郎にコピペしてプリントアウトし、紙で読もうと思った。

しかし、そこでちょっと困ったことに気づいた。

f:id:akashi_keirin:20190706223217j:plain

これである。

文中のところどころに(●●●●)のような、カッコでくくったハナクソが大量にあるのである。

最初は何かのミスだと思ったのだが、よくよく読んでみると、

直前の文字列に傍点があるというサイン

らしい。

つまり、

f:id:akashi_keirin:20190706223220j:plain

こういうことだ。

しかし、文中のあちこちにハナクソみたいな記号群があると、読みにくくて仕方がない。

何とかマクロで整形できないものか、考えてみた。

先に断っておくが、今のところまったく実用性のないソリューションになっているので、期待しないように。

コード

とりあえず、作成したコードをぶちまけておく。

リスト１　標準モジュール

Option Explicit

Private Sub main()
  Call putEmphasisMarkToDocument
  Call removeMarks
End Sub

Private Sub putEmphasisMarkToDocument()
  Dim doc As Document
  Set doc = ThisDocument
  Dim i As Long
  Dim targetCount As Long
  Dim hasStarted As Boolean
  Dim startPos As Long
  Dim endPos As Long
  For i = 2 To doc.Characters.Count
    'カウントモード中に「●」に出会ったら、targetCountをインクリメントする'
    If hasStarted Then _
      If doc.Characters(i) = "●" Then targetCount = targetCount + 1
    'カウントモード中に「)」に出会ったら、startPosを確定させて傍点を施す'
    If hasStarted Then
      If doc.Characters(i) = ")" Then
        startPos = endPos - targetCount + 1
        Call putEmphasisMark(doc, startPos, endPos)
        'カウントモード解除'
        hasStarted = False
      End If
    End If
    'カウントモード中は「(●」を探す必要なし'
    If hasStarted Then GoTo Continue
    Dim tmp As String
    tmp = doc.Characters(i - 1).Text & doc.Characters(i).Text
    '「(●」を見つけたら、targetCountを初期化し、カウントモードにした上で、'
    'endPosの値を決める'
    If tmp = "(●" Then _
      targetCount = 1: hasStarted = True: endPos = i - 2
Continue:
  Next
End Sub
'指定された文字に傍点を施す'
Private Sub putEmphasisMark(ByVal targetDoc As Document, _
                             ByVal startPos As Long, _
                             ByVal endPos As Long)
  Dim i As Long
  For i = startPos To endPos
    targetDoc.Characters(i).EmphasisMark = wdEmphasisMarkOverComma
  Next
End Sub

'元の印（「(●●●)」）を削除する'
Private Sub removeMarks()
  Dim orgRange As Range
  Set orgRange = Selection.Range
  Dim doc As Document
  Set doc = ThisDocument
  Call doc.Range(0, 0).Select
  Do
    With Selection.Find
      .MatchWildcards = False
      .MatchFuzzy = False
      .Text = "(●"
      Call .Execute
      If Not .Found Then Exit Do
    End With
    Call Selection.Collapse(Direction:=wdCollapseStart)
    With Selection
      Call .Extend(Character:=")")
      Call .Delete
    End With
  Loop
  Call orgRange.Select
End Sub

もう、恥ずかしくなるぐらいの力業。強引にもほどがある。

[Document].Charactersコレクションを総当たりにしているので、11万字overのドキュメントにこのマクロを実行したら、当分終わらないだろうと思う。

一応説明しておくと、次のような手順で傍点を施している。

文書の先頭から１文字づつ当たっていき、「(●」になっているところを探す。
見つかったら、カウントモードをオンにする。（hasStartedをTrueにする。）
同時に、傍点を施す最後の文字の位置が分かるので、endPosにセットする。
引き続き１文字づつ当たっていく。「●」である限り、targetCountをインクリメントする。
「)」に当たったら、その時点でのtargetCountの値が傍点を施すべき文字数。これで、傍点を施す開始位置が判明するので、startPosにセットする。
傍点を施すべきCharactersコレクションの開始インデックス（startPos）と終了インデックス（endPos）が分かっているので、それぞれの要素のEmphasisMarkプロパティを設定する。

今改めて書き起こしても、実に強引なやり方だ……。

一通り傍点を施し終わったら、あとはハナクソ軍団を削除するのみ。

WordVBAについてはまだまだよくわかっていないので、こちらも強引な手法となった。簡単に手順を記しておくと、

Findオブジェクトを用いて、先頭から順に「(●」を探す。
見つかったら、一旦始点側に選択範囲を潰す。
Selection.Extendメソッドを用いて選択範囲を広げる。引数Characterに「)」を渡すことにより、終端のカッコまで選択範囲を広げてくれる。
先頭のカッコ～終端のカッコが選択された状態になるので、Deleteメソッドを用いて削除する。
繰り返し。

まあ、こんな感じ。