Tableオブジェクトの怪(Word)

Tableオブジェクトの怪(Word)

実に気色悪い現象に出くわしたので報告。

表の余分な行を削除する

たとえば、Wordでドキュメント内の表にデータを差し込むようなとき、

このように、使用しない行が生ずることがある。

宛先によってデータの数が異なるとき、テキトーな上司なら「ま、別にええんちゃう？」で済むのだが、神経質な上司だったりすると、「空白行は消さんかい！」などということに。

そこで、マクロで空白行を削除することを企てるのである。

マクロで空白行を削除する

次のようなコードで、空白行の削除を試みる。

リスト１

Private Sub test03()
  Dim tbl As Table
  Set tbl = ActiveDocument.Tables(1)  '……(1)'
  Dim i As Long
  With tbl    '……(2)'
    For i = .Rows.Count To 2 Step -1  '……(3)'
      If .Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then  '……(4)'
        Call .Rows(i).Delete
      Else
        Exit For
      End If
    Next
  End With
End Sub

まず、(1)の

Set tbl = ActiveDocument.Tables(1)

で対象の表（Tableオブジェクト）を変数tblにぶち込む。

(2)の

With tbl

で記述をまとめておいて、(3)の

For i = .Rows.Count To 2 Step -1
  If .Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then  '……(4)'
    Call .Rows(i).Delete
  Else
    Exit For
  End If
Next

のForループ。

「削除するときはケツから！」の原則に基づいて、TableオブジェクトのRowsコレクションのCountプロパティの値、すなわち表の行数からスタートして、2行目まで繰り返すことにする。

ループ内では、(4)の

If .Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then

で、１列目に文字が入っているかどうかを判定。

Wordの表では、文字の入っていないセルにはChr(13)とChr(13)が入っている。

akashi-keirin.hatenablog.com

セル内に文字が入っていなければ

Call .Rows(i).Delete

で行ごと削除。

セル内に文字が入っていれば、（上の行から順にデータを入れている以上）これ以上削除する行はないと言うことだからElseブロックに進んで

Exit For

でループを抜ける。

実行

これで基本的にはうまいこと行くはずである。

しかし、ループに突入し、一つ目（つまり、5行目）を削除した途端、

工工工ｴｴｴｴｴｴｪｪｪｪｪｪ(ﾟДﾟ)ｪｪｪｪｪｪｴｴｴｴｴｴ工工工

何故、何故なんだ～？！

突然表の横幅がビニョーーーーンと伸びてしもたやないか……。

[Table].ColumnsコレクションからColumnオブジェクトを取得してWidthプロパティを調べてみる。

上が無残にも横に引き延ばされてしまったTables(1)、下があらかじめ同じものをコピッペしておいたTables(2)である。

このように、全然違うサイズに変わり果ててしまっていることがわかる。

おわりに

さっぱりわけがわからん。

何故、何故なんだ～？！（２回目。）

改行マークの怪(Word)

改行マークの怪

前回

akashi-keirin.hatenablog.com

の続き。

改行マークの正体とは？

まず、

このようなドキュメント（笑）を用意し、画像のように改行マークを選択状態にしておく。

そして、イミディエイトに

?Asc(Selection.Range.Text)

と入力して[Enter]を押す。

このように、「11」を得た。

charset.7jp.net

コチラの文字コード表によると、「11」は、

なんと、「VT」というよくわからないものだった。

てっきり「10」の「LF」だと思っていたのだが。

検証

では、選択部分を文字コード「10（LF）」にするとどうなるのか。

このように改行マークを選択した状態でイミディエイトに

Selection.Range.Text = Chr(10)

と入力して[Enter]を押す。すると、

工工工ｴｴｴｴｴｴｪｪｪｪｪｪ(ﾟДﾟ)ｪｪｪｪｪｪｴｴｴｴｴｴ工工工

これ、改段落マークとちゃいますのん？？？

さらに検証

では、この「改段落マーク」は何ものなのだろうか。

先ほど出現した「改段落マーク」（「Chr(10)」のはず。）を選択状態にして、イミディエイトに

?(Selection.Range.Text = vbCr)

と入力して[Enter]を押す。すると、

(ﾟДﾟ)ﾊｧ?(ﾟДﾟ)ﾊｧ?(ﾟДﾟ)ﾊｧ?

えっ……なんで……？？？　そうなの？？？

さらに、イミディエイトに

?(Selection.Range.Text = Chr(13))

と入力して[Enter]を押す。すると、

(ﾟДﾟ)ﾊｧ?(ﾟДﾟ)ﾊｧ?(ﾟДﾟ)ﾊｧ?

えっ……なんで……？？？　Selection.Range.TextはChr(10)にしたやんか……。

さらに、イミディエイトに

?(Selection.Range.Text = Chr(10))

と入力して[Enter]を押す。すると、

(ﾟДﾟ)ﾊｧ?(ﾟДﾟ)ﾊｧ?(ﾟДﾟ)ﾊｧ?

そもそもSelection.Range.TextをChr(10)にしたはずなのに、一周回ってChr(10)じゃなくなっとる……。

おわりに

さっぱりわけがわかりまへん。

改行・改段落の怪(Word)

改行・改段落の怪

前回

akashi-keirin.hatenablog.com

の続き。

前回のリスト１を再掲する。

前回のリスト１

'テキストの置換'
Private Sub replaceText(ByVal str1 As String, _
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  
  With Selection.Find
    Call .Execute(FindText:=str1, _
                  replacewith:=str2, _
                  Replace:=wdReplaceAll)
  End With
  
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
End Sub

Private Sub removeUnsightlyCR()
  '連続するCarriageReturnを一つにする'
  Call replaceText(vbCr & vbCr, vbCr)  '……(*)'
End Sub

これの(*)の部分、replaceTextメソッドの第２引数をvbLfに変えたらどうなるのだろうか。やってみた。

vbCrをvbLfに置き換える

前掲リストの(*)部分を次のように書き換える。

Call replaceText(vbCr & vbCr, vbLf) 

そして、

おなじみ、このドキュメント（笑）を用意して、上掲コードを実行する。

な････なんだってーーー！？

なかなか衝撃的な結果ではあるまいか。

てっきり

こうなるものと思っていたのだが。

おわりに

ますますわけがわからなくなってきたぞ。

VBAによる置換の怪(Word)

VBAによる置換の怪

ちょっと変な現象に出くわしたので報告。

無駄な改段落マークを削除する

最近、Webページ上で公開されている議事録の類をWordドキュメント化する作業にハマっている。今すぐ役に立つわけではないけれど、後で利用するときに楽かな、と思って。

Webページ上からWordドキュメントにテキスト部分をコピッペして、後は主にマクロを使って整形する。

そのときにやたら遭遇するのが

のようなパターン。

行と行の間に無駄な改段落マークがあるやつ。

まずはこいつを一掃したかった。

要は、二つ連なっている改段落マークを一つにすればよいのだから、次のようなコードでやった。

リスト１

'テキストの置換'
Private Sub replaceText(ByVal str1 As String, _
                        ByVal str2 As String)
  With Selection.Find    '……(1)'
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  
  With Selection.Find    '……(2)'
    Call .Execute(FindText:=str1, _
                  replacewith:=str2, _
                  Replace:=wdReplaceAll)
  End With
  
  With Selection.Find    '……(3)'
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
End Sub

Private Sub removeUnsightlyCR()    '……(4)'
  '連続するCarriageReturnを一つにする'
  Call replaceText(vbCr & vbCr, vbCr)
End Sub

まずは、replaceTextメソッド。

str1とstr2の二つの引数を受け取って、ドキュメント中のstr1をstr2に置換する。それだけ。

(1)の

With Selection.Find
  Call .ClearFormatting
  Call .Replacement.ClearFormatting
End With

でFindオブジェクトの設定をリセットする。

次に(2)の

With Selection.Find    '……(2)'
  Call .Execute(FindText:=str1, _
                ReplaceWith:=str2, _
                Replace:=wdReplaceAll)
End With

でFind.Executeメソッドを実行する。

str1をstr2に置換したいので、引数FindTextにstr1を、引数ReplaceWithにstr2を渡す。

また、全て置換するために引数ReplaceにはwdReplaceAllを渡す。

後は、(3)の

With Selection.Find
  Call .ClearFormatting
  Call .Replacement.ClearFormatting
End With

で再度Findオブジェクトをリセットしておしまい。

このreplaceTextメソッドを、(4)の

Private Sub removeUnsightlyCR()
  '連続するCarriageReturnを一つにする'
  Call replaceText(vbCr & vbCr, vbCr)
End Sub

のように、str1にvbCr & vbCr（二つ連なった改段落マーク）、str2にvbCrを指定して実行することによって、行のカンチャンの目障りな改行マークを一掃するのである！

実行

さて、

この状態で、上記リスト１のremoveUnsightlyCRを実行すると、当然

こうなる。

しかし！

この状態で、イミディエイトに

?ActiveDocument.Paragraphs.Count

と打ち込んで[Enter]を押すと、

な、なんだってーーー！？

なんと、段落数は1なのである。

どう見ても5なのに。

標準機能で置換する

ちなみに、

このように、標準機能を用いて置換した場合、

段落数は5になる。VBAでやった場合と標準機能を用いた場合とで結果が異なるのである。まさにち～んｗ珍現象！

おわりに

テキストドキュメントを整形する機会のある人は、注意しましょう。

段落冒頭の半角スペースを除去する(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を用いて、同じく上記「考え方」を元に次のリスト１を作成。

リスト１

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 」と入力して置換したら一発

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

Custom Collection Classのすすめ(1)

Custom Collection Classのすすめ(1)

PersonクラスとPersonsクラス

ちょっと次のコードをご覧いただきたい。

リスト１

Private Sub test01()
  Dim proWrestlers As Persons
  Set proWrestlers = New Persons
  With proWrestlers
    Call .Add
    Call .Add("阿修羅原", "ラリアート")
    Call .Add("平田淳嗣")
  End With
  Dim pw As Person
  For Each pw In proWrestlers
    With pw
      Debug.Print .Name & " : " & .FavoriteHold
    End With
  Next
End Sub

ちょっとだけ解説すると、PersonとPersonsという自作のクラスがあり、PersonオブジェクトのAddメソッドを実行すれば、PersonsオブジェクトにPersonオブジェクトが追加されるようにしている。

この説明だけ見れば、丁度Personsコレクションの要素がPerson オブジェクト、という関係である。

で、上掲コードの

For Each pw In proWrestlers
  With pw
    Debug.Print .Name & " : " & .FavoriteHold
  End With
Next

の部分。

変数pwにはPersonクラスのインスタンスが入り、変数proWrestlersにはPersonsクラスのインスタンスが入っている。

で、通常このリスト１を実行するとどうなるか。

当然こうなるのである。

原因は

当然ここ。

Personsは所詮勝手に作ったクラスに過ぎず、Collectionではないからだ。

For Eachが使える？！

ところが、『VBA Developer's Handbook Second Edition』で紹介されていたテクニックをちょこちょこっと使うと、

こんなふうにフツーに動く。

まるで、PersonsオブジェクトがPersonオブジェクトのCollectionであるかのように振る舞うのである！

おわりに

ちょっとスゴくないですか？

次回に続く！

続かないかも知れんけどｗ

WordのRangeオブジェクトの謎挙動

WordのRangeオブジェクトの謎挙動

完全にわけがわからなくなってしまった。

Find.Executeメソッドで特定の文字列の箇所をRangeオブジェクトとして取得する

次のようなメソッドを作成し、現在のカーソル位置の直近にある指定した文字列の場所をRangeオブジェクトとして取得する。

getNextTextRangeメソッド

Private Function getNextTextRange( _
             ByVal tgtText As String) As Range
  Dim ret As Range
  Set ret = Nothing
  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 Exit Function
  Set ret = Selection.Range
  Set getNextTextRange = ret
End Function

Findオブジェクトのプロパティが大量にあるせいでタテ長になっているが、やっていることは簡単。引数tgtTextで指定した文字列を現在のカーソル位置から後方に向かって検索し、最初にヒットした箇所のRangeオブジェクトを返す。それだけ。

で、こいつを使って、指定した文字列にルビを振るということをやってみる。

文字列を検索してルビを振る

次のようなドキュメント（笑）を用意して先頭にカーソルを置き、

次のコードでやってみる。

リスト１

Private Sub testRangeObject()
  Dim wordRange As Range
  Set wordRange = getNextTextRange("強敵")  '……(1)'
  Call wordRange.PhoneticGuide("とも")      '……(2)'
  Call wordRange.PhoneticGuide("ち～んｗ")  '……(3)'
End Sub

(1)の

Set wordRange = getNextTextRange("強敵")

で、「強敵」の部分をRangeオブジェクトとして取得し、変数wordRangeに突っ込む。

んで、(2)の

Call wordRange.PhoneticGuide("とも")

で、[Range].PhoneticGuideメソッドを用いて「強敵」部分に「とも」とルビを振る。ラオウ語法である。

そして、すかさず(3)の

Call wordRange.PhoneticGuide("ち～んｗ")

でルビを「ち～んｗ」に変更する。

それだけだ。

フツーに実行すると一瞬で終わってしまうので、ステップ実行の様子をお目にかけよう。

この通り、期待通りの動きをしてくれていることがわかる。

すでにルビがある状態では？

では、これを再度実行してみる。

ドキュメント（笑）は、

この状態。もちろん、カーソルは先頭に戻してある。

リスト１を再度実行すると、

この体たらく。

実行後、

このように「強敵」部分が選択状態になっていることからすると、wordRangeにはちゃんとRangeオブジェクトが格納されている。

このことは、リスト１を次のように変更して、

リスト１改

Private Sub testRangeObject()
  Dim wordRange As Range
  Set wordRange = getNextTextRange("強敵")
  Debug.Print wordRange.Text    '……(*)'
  Call wordRange.PhoneticGuide("とも")
  Call wordRange.PhoneticGuide("ち～んｗ")
End Sub

実行すると、(*)のところでイミディエイトに

と表示されることからもわかる。

おわりに

まったくわけがわからない。

一体何なのでしょう？？？