『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
処理の手順は、コード中のコメントのとおり。
実行
とりあえず、13,169文字分のテキストをWordに貼り付けて実験してみる。
(1)の
Call doc.Range(0, 0).Select
で、
こうなる。
With Selection.Find .MatchWildcards = False .MatchFuzzy = False .Text = "(●" Call .Execute '……(2)' 'ヒットしなければ終了' If Not .Found Then Exit Do End With
この(2)を実行したところで、
こうなる。
(3)の
Call Selection.Collapse(wdCollapseStart)
を実行すると、
こうなる。
(4)の
Call Selection.Extend(")")
を実行すると
こうなる。
(5)の
Call Selection.MoveLeft(Unit:=wdCharacter, _ Count:=charCount, _ Extend:=wdExtend)
を実行すると、
こうなる。
そして、(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
を実行すると、
こうなる。
(4)の後、ハナクソ(「(●●●)」)は、変数refRange
ぶち込んであるので、(7)の
Call refRange.Delete
を実行して除去する。
ただし、除去した後は
このように除去したハナクソの数(画像の場合は三つ)分だけ選択された状態になるので、選択範囲を終端に向かって潰しておく必要がある。
ちなみに、一気にこのコードを完走させると、
こうなる。激速!
おわりに
非常にニッチなニーズ(そもそも存在するのか?)にお応えしました。