段落冒頭の半角スペースを除去する(Word)

各段落冒頭の半角スペースを取り除く

Webで公開されている議事録の類をWordドキュメント化することが割と増えた。

しばらく待っているとPDFで正式な議事録が出される場合もあるが、割と時間がかかる上、PDFだと記載内容をコピッペする際に割とめんどくさい。

そこで、Webページに掲載されている議事録のテキストをWordドキュメントにコピッペして整形する、という方法をとった。

段落冒頭にことごとく半角スペースがある問題

Webページから直接コピッペすると、改行位置もちゃんと反映されるので、整形するにあたっては実に楽。

ただし、今回私が取り扱った物件は、

行頭にことごとく半角スペースが入っている

という実にうっとうしいものであった。

何せ、Wordドキュメントで約30ページ、4万字超の議事録が五つも六つもあるのである。手作業で取り除くのはナンセンス。

ただ半角スペースの全てを取り除けば良いわけではないから、置換も使えない。

そこで、マクロでやることにした。

考え方

次のように考えた。

  • 取り除きたいのは段落冒頭の半角スペースに限る。
  • したがって、まずは改段落マークの場所(Rangeオブジェクト)を取得する。
  • 改段落マークの場所を取得したら、その次の文字の場所(Rangeオブジェクト)を取得する。
  • 次の文字の場所を表すRangeオブジェクトのTextプロパティの値を調べ、そいつが半角スペースだったら""で置きかえる。
  • 検索で改段落マークがヒットしなくなるまでループ

うむ、万全である!

指定した文字列の場所(Range)を取得するメソッド

getNextTextRangeメソッド
Private Function getNextTextRange( _
             ByVal tgtText As String) As Range
  Dim ret As Range
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  With Selection.Find
    .Text = tgtText
    .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
  If Not Selection.Find.Found Then GoTo Finalizer
  Set ret = Selection.Range
  Call Selection.Collapse(wdCollapseEnd)
Finalizer:
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  Set getNextTextRange = ret
End Function

Findオブジェクトを使う際の宿命、どうしてもタテ長になってしまう。しかし、やっていることは非常に簡単。引数tgtTextで受け取った文字列が見つかったら、その場所を取得してRangeオブジェクトを返すだけ。

段落冒頭の半角スペースを除去する

上記getNextTextRangeを用いて、同じく上記「考え方」を元に次のリスト1を作成。

リスト1
Private Sub removeSBSpaceAtTheTopOfParagraph()
  Dim tmpRange As Range
  Do
    Set tmpRange = getNextTextRange(vbCr)  '……(1)'
    If tmpRange Is Nothing Then Exit Do
    Call tmpRange.Select  '……(2)'
    Call Selection.Collapse(wdCollapseEnd)
    Call Selection.MoveRight(wdCharacter, 1, wdExtend)  '……(3)'
    If Selection.Range.Text = " " Then  '……(4)'
      Selection.Range.Text = ""
    End If
    DoEvents
  Loop
  Call ActiveDocument.Range(0, 0).Select
End Sub

いきなりDoループに突入!

(1)からの2行、

Set tmpRange = getNextTextRange(vbCr)
If tmpRange Is Nothing Then Exit Do

で先のgetNextTextRangeメソッドを用いて直近の改行改行マークの場所(Rangeオブジェクト)を取得。

tmpRangeNothingだったらループを抜ける。

次に、(2)からの2行、

Call tmpRange.Select
Call Selection.Collapse(wdCollapseEnd)

で、先ほど取得したRangeオブジェクトを選択状態にし、

f:id:akashi_keirin:20200308091738j:plain

さらに選択範囲を後方に向かって潰しておく。

f:id:akashi_keirin:20200308091741j:plain

そして、(3)の

Call Selection.MoveRight(wdCharacter, 1, wdExtend)

で、右に向かって1文字分だけ選択範囲を広げる。

これで、改行マークの次の1文字を選択した状態になる。

f:id:akashi_keirin:20200308091745j:plain

あとは、(4)からの3行、

If Selection.Range.Text = " " Then
  Selection.Range.Text = ""
End If

で、選択されている箇所(次の段落の冒頭)が半角スペースだったらそいつを""に置きかえる。

f:id:akashi_keirin:20200308091747j:plain

この繰り返し。

ちなみに、getNextTextRangeがドキュメント(笑)最後の改行マークの場所を取得したときは、

Call tmpRange.Select

を実行すると、

f:id:akashi_keirin:20200308091932j:plain

こうなって、

Call Selection.Collapse(wdCollapseEnd)

を実行して、

f:id:akashi_keirin:20200308091936j:plain

こうなって、

Call Selection.MoveRight(wdCharacter, 1, wdExtend)

を実行して、

f:id:akashi_keirin:20200308091939j:plain

こうなる。んで、この状態で次のループに突入してgetNextTextRangeメソッドを実行すると、

f:id:akashi_keirin:20200308091943j:plain

このように、なぜか改行マークが検索でヒットせず(Find.FoundプロパティがFalseを返す)、getNextTextRangeメソッドがNothingを返すので、無事にDoループから抜け出すことができる。

最後に動作の様子をお目にかけよう。

f:id:akashi_keirin:20200308091946g:plain



うむ、バッチリである!!!!!!!!!!!!!!!!

おわりに

んで、ここまで書いておいてアレなんですが……。

これ、

[Ctrl]+[ H ]で置換ダイアログ呼んで、「検索する文字列」に「^p 」(「 ^p」と半角スペース)、「置換後の文字列」に「^p 」と入力して置換したら一発

ということに気づきましたよ。とほほ……。