「青空文庫」をWordVBAで攻略する(1)

WordVBA

「青空文庫」のテキストからルビ用文字列を除去する

「青空文庫」からダウンロードしたテキストファイルを、WordVBAを用いて整形していきます。

今回は、手始めに〝ルビ用文字列〟の除去を行います。

目次

こんなことができます

「青空文庫」からテキストデータをダウンロードすると、

f:id:akashi_keirin:20210130221548j:plain

中身はこうなっている。

見ての通り、

櫂《かい》の木太刀

本文中でルビが振られている文字の後ろに、「《》」で括ってルビの文字列を示してある。

これはこれで実に重要な情報なのだが、読む際にはただただ邪魔である。

このテキストデータをWordに貼り付けた後、読みやすいように「《》」で括られた部分を除去したい。

f:id:akashi_keirin:20210130221551j:plain

これを、

f:id:akashi_keirin:20210130221912j:plain

こういう状態にするのである。

ルビ用文字列の位置を取得する

考え方

除去するためには、まず場所を特定せねばならん。

これは簡単。ルビ文字列はことごとく「《》」で括られているのだから、「《」の位置と「》」の位置を取得して、その範囲を取得すればよい。

文字を検索し、その位置を返すFunction

Findオブジェクトを利用するFunctionを作る。

リスト１　標準モジュールFormatStrings
Private Function getNextPosition( _
             ByVal FindText As String) As Long  '……(1)'
  Dim ret As Long  '……(2)'
  ret = -1
  With Selection.Find    '……(3)'
    .Text = FindText
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Format = False
    .Highlight = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
  End With
  Call Selection.Find.Execute    '……(4)'
  If Not Selection.Find.Found Then GoTo ReturnValue  '……(5)'
  ret = Selection.Range.Start    '……(6)'
  Call Selection.Collapse(wdCollapseEnd)  '……(7)'
ReturnValue:    '……(8)'
  getNextPosition = ret
End Function

まず、(1)の

Private Function getNextPosition( _
             ByVal FindText As String) As Long

で引数と返り値を設定。

検索文字列を受け取って、ドキュメント内での位置を表す整数を返すようにした。

(2)からの2行

Dim ret As Long
ret = -1

返り値用の変数retを用意して、初期値-1を設定。

文字列の位置が負の数になることはないので、検索がうまくいかなかったことがわかるようにこうしている。

(3)からの14行

With Selection.Find
  .Text = FindText
  .Replacement.Text = ""
  .Wrap = wdFindStop
  .Format = False
  .Highlight = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = False
  .MatchFuzzy = False
End With

は、おなじみ、Findオブジェクトの初期設定。

純粋に文字列を検索したいだけなので、ほとんどの項目がFalse。

WrapプロパティをwdFindStopにしているのは、後方検索オンリーにしたいがゆえ。

この辺りの挙動は、となりITさんのこちらの記事が詳しいのでどうぞ。

(4)の

Call Selection.Find.Execute

で検索実行。

(5)の

If Not Selection.Find.Found Then GoTo ReturnValue

でFoundプロパティを調べる。

FoundプロパティがFalseだということは、そもそも検索でヒットしなかったということなので、即座にReturnValueラベルに吹っ飛ばして、-1を返す。

(6)にたどり着いたということは、検索でヒットしたということ。

この時点で、Wordドキュメント上ではヒットした文字列が選択された状態になっている。

たとえば、「ち～んｗ」という文字列がヒットした場合、(5)の実行後は、

f:id:akashi_keirin:20210130221554j:plain

こんな状態になっている。

そこで、(6)の

ret = Selection.Range.Start

で選択箇所の始端位置を取得し、返り値用変数retにぶち込む。

このままだと、検索でヒットした箇所が選択状態なので、次に検索するときに検索対象がこの箇所オンリーになってしまって困る。

そこで、(7)の

Call Selection.Collapse(wdCollapseEnd)

で、選択箇所を後方に潰しておく。

あとは、(8)の

ReturnValue:
  getNextPosition = ret

で返り値をセットしておしまい。

ルビ文字列の箇所を表すRangeオブジェクト

これで、ルビ文字列の箇所、すなわち〝「《》」で括られた文字列の箇所〟を取得する準備がととのった。

ここからの手順は次の通り。すなわち、

  1. リスト１のgetNextPositionメソッドを用いて、「《」の位置を取得する
  2. 同様に「》」の位置を取得する
  3. [Document].Rangeメソッドに上記1.・2.で取得した開始位置・終了位置を渡してRangeオブジェクトを取得する

これでオッケーである。

コードとしては、

Dim startPos As Long
startPos = getNextPosition("《")
Dim endPos As Long
endPos = getNextPosition("》") + 1  '……(*)'
Dim tgtRange As Range
Set tgtRange = ActiveDocument.Range(startPos, endPos)

とすればオッケー。

(*)のところで「 + 1」しているのは、getNextPositionメソッドが検索でヒットした文字列の開始位置を取得するから。

ヒットした文字列（この場合は「》」）の文字数分だけプラスしてやれば終了位置になる。

ルビ用文字列を除去する

ここまでで、除去対象の箇所を表すRangeが取得できている。

あとは簡単。

[Range].Textプロパティに""をセットしてやればよい。上のコードで言えば、

tgtRange.Text = ""

とすればよい。楽勝。

ルビ用文字列を次々に除去する

「《》」で括られた箇所を除去するFunction

まず、先に記した手順をひとまとめにしたFunctionを作っておく。

リスト２　標準モジュールFormatStrings
Public Function ReplaceSpecifiedRange( _
            ByVal StartChar As String, _
            ByVal EndChar As String, _
   Optional ByVal ReplaceText As String = "") As Boolean
  ReplaceSpecifiedRange = False
  'getNextPositionは、文字列がみつからなかったら-1を返す'
  Const NOT_FOUND As Long = -1
  Dim startPos As Long
  startPos = getNextPosition(StartChar)
  If startPos = NOT_FOUND Then Exit Function
  Dim endPos As Long
  endPos = getNextPosition(EndChar)
  If endPos = NOT_FOUND Then Exit Function
  endPos = endPos + Len(EndChar)
  If startPos > endPos Then Exit Function
  
  Dim tgtDoc As Document
  Set tgtDoc = ActiveDocument
  Dim tgtRange As Range
  Set tgtRange = tgtDoc.Range(startPos, endPos)
  tgtRange.Text = ReplaceText
  ReplaceSpecifiedRange = True
End Function

引数StartCharとEndCharで挟まれた文字列を、まるごと引数ReplaceTextの文字列に置き換える、というもの。

今回の例であれば、

Call FormatStrings.ReplaceSpecifiedRange("《", "》", "")

とすれば、たとえば「《ち～んｗ》」をごっそり除去できる、ということになる。

上ではCallを用いたが、置換に成功すればTrue、置換できなければFalseを返すようにしているので、たとえば、

Do
  If Not FormatStrings.ReplaceSpecifiedRange("《", "》", "") Then
    Exit Do
  End If
Loop

とでもしておけば、文書の終端まで除去し続けることになる。

f:id:akashi_keirin:20210130221557g:plain

こんな感じに。（わかりやすいように、Sleepをかましています。）

おわりに

手作業で除去しようとすると恐ろしい手間がかかりますが、これだと楽勝。

こういう場面では、WordのVBAが大活躍します。

補足

ワイルドカードを用いて〝「《 》」で括られた箇所を取得する〟方法については、

akashi-keirin.hatenablog.com

コチラをどうぞ。