段落冒頭の半角スペースを除去する(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
オブジェクト)を取得。
tmpRange
がNothing
だったらループを抜ける。
次に、(2)からの2行、
Call tmpRange.Select Call Selection.Collapse(wdCollapseEnd)
で、先ほど取得したRange
オブジェクトを選択状態にし、
さらに選択範囲を後方に向かって潰しておく。
そして、(3)の
Call Selection.MoveRight(wdCharacter, 1, wdExtend)
で、右に向かって1文字分だけ選択範囲を広げる。
これで、改行マークの次の1文字を選択した状態になる。
あとは、(4)からの3行、
If Selection.Range.Text = " " Then Selection.Range.Text = "" End If
で、選択されている箇所(次の段落の冒頭)が半角スペースだったらそいつを""
に置きかえる。
この繰り返し。
ちなみに、getNextTextRange
がドキュメント(笑)最後の改行マークの場所を取得したときは、
Call tmpRange.Select
を実行すると、
こうなって、
Call Selection.Collapse(wdCollapseEnd)
を実行して、
こうなって、
Call Selection.MoveRight(wdCharacter, 1, wdExtend)
を実行して、
こうなる。んで、この状態で次のループに突入してgetNextTextRange
メソッドを実行すると、
このように、なぜか改行マークが検索でヒットせず(Find.Found
プロパティがFalse
を返す)、getNextTextRange
メソッドがNothing
を返すので、無事にDo
ループから抜け出すことができる。
最後に動作の様子をお目にかけよう。
うむ、バッチリである!!!!!!!!!!!!!!!!
おわりに
んで、ここまで書いておいてアレなんですが……。
これ、
[Ctrl]+[ H ]で置換ダイアログ呼んで、「検索する文字列」に「^p
」(「 ^p
」と半角スペース)、「置換後の文字列」に「^p
」と入力して置換したら一発
ということに気づきましたよ。とほほ……。