『BLOG「芦田の毎日」』(シラバスとは何か ― コマシラバスはなぜ必要なのか)の本文を読みやすく加工するマクロ(Word)

『BLOG「芦田の毎日」』(シラバスとは何か ― コマシラバスはなぜ必要なのか)の本文を読みやすく加工するマクロ(Word)

我ながら超ニッチなマクロであるw

過去記事

このときにも紹介したが、標題の記事は、

※本文中、(●)などの表記が見られる場合は、その前に来る言葉の傍点ルビや読みがなルビを意味している。●が一個だと前の文字一つのルビ、●●と2個だと前の文字二つのルビなどを意味する。

という表記ルールで書かれているため、そのままだと異様に読みづらい。

そこで、本文中の必要な箇所に傍点を施し、邪魔なハナクソ(「「●」などの表記」のこと)を除去するマクロを作った。

誰のために?

自分のために決まっているじゃありませんか!

コード

とりあえず、コードを全て掲載する。

我ながら非常にreadableなので、何も説明は要らないと思う。

うそです。ほとんどコード中にコメントで書きましたw

リスト1 標準モジュール
Option Explicit

Private Sub main()
  Dim orgRange As Range
  Set orgRange = Selection.Range
  Call putEmphasisMarkToDocument
  Call orgRange.Select
End Sub

Private Sub putEmphasisMarkToDocument()
  Dim doc As Document
  Set doc = ThisDocument
  Call doc.Range(0, 0).Select	'……(1)'
  Do
    '「(●」を探す'
    With Selection.Find
      .MatchWildcards = False
      .MatchFuzzy = False
      .Text = "(●"
      Call .Execute    '……(2)'
      'ヒットしなければ終了'
      If Not .Found Then Exit Do
    End With
    '開始位置を変数にセットする'
    Dim baseRange As Range
    Call Selection.Collapse(wdCollapseStart) '……(3)'
    Set baseRange = Selection.Range
    '選択範囲を「)」まで延ばす'
    Dim refRange As Range
    Call Selection.Extend(")")    '……(4)'
    Set refRange = Selection.Range
    '文字数を取得する'
    Dim charCount As Long
    charCount = refRange.Characters.Count - 2 'カッコの分は引く'
    '変数にセットした開始位置から逆方向に文字数分選択範囲を延ばす'
    Call baseRange.Select
    Call Selection.MoveLeft(Unit:=wdCharacter, _
                            Count:=charCount, _
                            Extend:=wdExtend)    '……(5)'
    'Selection.CharactersのEmphasisMarkプロパティをセットする'
    Call putEmphasisMark(Selection, charCount)    '……(6a)'
    'ハナクソを削除する'
    Call refRange.Delete    '……(7)'
    '削除後、charCount字数分だけ選択された状態なので、終端に向けて潰す'
    '潰しておかないと、次に選択範囲内だけを検索することになる'
    Call Selection.Collapse(wdCollapseEnd)
  Loop
End Sub

Private Sub putEmphasisMark(ByVal targetSelection As Selection, _
                            ByVal charCount As Long)    '……(6b)'
'指定された文字に傍点を施す'
  Dim i As Long
  For i = 1 To charCount
    targetSelection.Characters(i).EmphasisMark = wdEmphasisMarkOverComma
  Next
End Sub

処理の手順は、コード中のコメントのとおり。

実行

f:id:akashi_keirin:20190711082255j:plain

とりあえず、13,169文字分のテキストをWordに貼り付けて実験してみる。

(1)の

Call doc.Range(0, 0).Select

で、

f:id:akashi_keirin:20190711082259j:plain

こうなる。

With Selection.Find
  .MatchWildcards = False
  .MatchFuzzy = False
  .Text = "(●"
  Call .Execute    '……(2)'
  'ヒットしなければ終了'
  If Not .Found Then Exit Do
End With

この(2)を実行したところで、

f:id:akashi_keirin:20190711082302j:plain

こうなる。

(3)の

Call Selection.Collapse(wdCollapseStart)

を実行すると、

f:id:akashi_keirin:20190711082306j:plain

こうなる。

(4)の

Call Selection.Extend(")")

を実行すると

f:id:akashi_keirin:20190711082310j:plain

こうなる。

(5)の

Call Selection.MoveLeft(Unit:=wdCharacter, _
                            Count:=charCount, _
                            Extend:=wdExtend)

を実行すると、

f:id:akashi_keirin:20190711082313j:plain

こうなる。

そして、(6a)の

Call putEmphasisMark(Selection, charCount)

で(6b)に飛び、

Private Sub putEmphasisMark(ByVal targetSelection As Selection, _
                            ByVal charCount As Long)    '……(6b)'
Dim i As Long
  For i = 1 To charCount
    targetSelection.Characters(i).EmphasisMark = _
                                  wdEmphasisMarkOverComma
  Next
End Sub

を実行すると、

f:id:akashi_keirin:20190711082318j:plain

こうなる。

f:id:akashi_keirin:20190711082814g:plain

(4)の後、ハナクソ(「(●●●)」)は、変数refRangeぶち込んであるので、(7)の

Call refRange.Delete

を実行して除去する。

ただし、除去した後は

f:id:akashi_keirin:20190711082734j:plain

このように除去したハナクソの数(画像の場合は三つ)分だけ選択された状態になるので、選択範囲を終端に向かって潰しておく必要がある。

ちなみに、一気にこのコードを完走させると、

f:id:akashi_keirin:20190711082321j:plain

f:id:akashi_keirin:20190711082325j:plain

f:id:akashi_keirin:20190711082827g:plain

こうなる。激速!

おわりに

非常にニッチなニーズ(そもそも存在するのか?)にお応えしました。