改行マークの怪(Word)
改行マークの怪
前回
の続き。
改行マークの正体とは？
まず、
このようなドキュメント（笑）を用意し、画像のように改行マークを選択状態にしておく。
そして、イミディエイトに
?Asc(Selection.Range.Text)
と入力して[Enter]を押す。
このように、「11」を得た。
コチラの文字コード表によると、「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)
改行・改段落の怪
前回
の続き。
前回のリスト１を再掲する。
前回のリスト１
'テキストの置換'
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
実行すると、(*)のところでイミディエイトに
と表示されることからもわかる。
おわりに
まったくわけがわからない。
一体何なのでしょう？？？
Custom Event 入門
Custom Eventに挑戦
存在は知っていたけど、実はやったことなかった。
『VBA Developer's Handbook Second Edition』の説明が実にわかりやすかったので、ちょっとやってみようと思った。
まあ、単なる覚書です。
手順
今回は、三つのクラスモジュールを用いる。
Ahoクラス
アホを表すクラス（笑）。AhoesクラスAhoクラスのインスタンスの集合体を表すクラス。このクラスにイベントを装備する。- AhoTestクラス
Ahoesオブジェクトでイベントが起こったときに、そのイベント発生を検知して処理を行うクラス。
うーむ、わかりにくい。
もう少し詳しくやろうとしていることを述べる。
AhoesオブジェクトにAhoオブジェクトを追加するAddメソッドを持たせる。
AhoesオブジェクトでAddメソッドが実行されると、Addedイベントが起こるようにする。
AhoTestオブジェクトにAddedイベントを検知したときに実行されるイベントプロシージャを置く。
これで、AhoTestオブジェクト内の処理でAhoesクラスのAddメソッドを実行したときに、イベントプロシージャが実行されることになる。
うーむ、やっぱりわかりにくい。
Ahoクラスを作る
まずは、Ahoクラスを作る。
クラスモジュール Aho
Option Explicit Private name_ As String Public Property Get Name() As String Name = name_ End Property Public Sub init(ByVal name__ As String) name_ = name__ End Sub Public Sub introduceMyself() Dim msg As String msg = "アホ、アホ、アホの" & Me.Name & "～♪" Call MsgBox(msg) End Sub
initメソッドで名前を設定する。
Nameプロパティを持ち、introduceMyselfメソッドで素敵な自己紹介をするクラス。
Ahoesクラスを作る
次に、先ほど作成したAhoクラスのインスタンスを大量に保持することのできるAhoesクラスを作成する。
クラスモジュール Ahoes
Option Explicit 'Attribute Item.VB_UserMemId = 0 設定済み' 'Attribute NewEnum.VB_UserMemId = -4 設定済み' 'Event declarations' Public Event Added(ByVal AhoName As String) '……(1)' 'Module level variables' Private ahoes_ As Collection 'Properties' Public Property Get Count() As Long Count = ahoes_.Count End Property 'Constructor' Private Sub Class_Initialize() Set ahoes_ = New Collection End Sub 'Methods' Public Function Item(ByVal Index As Variant) As Aho Set Item = ahoes_.Item(Index) End Function Public Sub Add(ByVal AhoName As String, _ Optional ByVal Key As Variant, _ Optional ByVal Before As Variant, _ Optional ByVal After As Variant) Dim item_ As New Aho Call item_.init(AhoName) 'Fire event' RaiseEvent Added(AhoName) '……(2)' Call ahoes_.Add(item_, Key, Before, After) End Sub Public Sub Remove(ByVal Index As Variant) Call ahoes_.Remove(Index) End Sub Public Function NewEnum() As IUnknown Set NewEnum = ahoes_.[_NewEnum] End Function
組み込みのCollectionクラスをラップしたクラスにしている。
Itemメソッドをデフォルトメンバにしたり、NewEnumメソッドを実装して内部Collectionのahoes_の要素（Ahoオブジェクト）をFor Each ～ Nextで回せるようにしたりしているのだが、今回は関係ないのでパス。
ポイントは二つ。
まず宣言セクションにある、(1)の
Public Event Added(ByVal AhoName As String)
というやつ。
これがイベント宣言。「このクラスはこんなイベントを持っています」というもの。引数を持たせることができるので、イベントを検知して実行するプロシージャに引数を渡すことができる。
もう一つが、イベントを発生させたいAddイベント内にある(2)の
RaiseEvent Added(AhoName)
というやつ。
もう読んで字の如しで、この行が実行されると「イベント発生！」ということになる。『VBA Developer's Handbook Second Edition』では「Fire event」と説明されていた。
まさに、「発火」というイメージ。
AhoTestクラスを作る
さて、ここまででAddedイベントが起こるようにすることはできた。
Ahoesクラスのインスタンスを作成して、Addメソッドを実行すれば、めでたくAddedイベントは起こる。
しかし、このままではただイベントが起こるだけ。人知れずイベントが発生して終了し、見かけ上は何も起こらない。
イベントが起こったことを検知して、何らかの処理を行わねばならぬ。
そのために、イベントに対応して処理を行うクラスを作る。
それが、AhoTestクラスである。
クラスモジュール AhoTest
Option Explicit
Private WithEvents AhoesObject As Ahoes '……(3)'
Public Property Get Ahoes() As Ahoes
Set Ahoes = AhoesObject
End Property
Private Sub Class_Initialize()
Set AhoesObject = New Ahoes
End Sub
Private Sub AhoesObject_Added( _
ByVal AhoName As String) '……(4)'
Dim msg As String
msg = "アホの" & AhoName & vbCrLf
msg = msg & msg & msg & msg
msg = msg & "アホの" & AhoName & "～～～～♪" & vbCrLf
msg = msg & "おれぁ、そういう男よ。"
Debug.Print msg
End Sub
ポイントは二つ。
まず、宣言セクションにある(3)の
Private WithEvents AhoesObject As Ahoes
こいつ。
Ahoesクラスのインスタンスを保持するためのモジュールレベル変数なんだが、WithEventsというキーワードが付いている。
こうすることで、AhoesObjectは、単なるAhoesクラスのインスタンスではなく、Ahoesオブジェクトで起こったイベントを検知することのできるちょっと特別なインスタンスになるのだ！
そして、(4)の
Private Sub AhoesObject_Added( _
ByVal AhoName As String)
Dim msg As String
msg = "アホの" & AhoName & vbCrLf
msg = msg & msg & msg & msg
msg = msg & "アホの" & AhoName & "～～～～♪" & vbCrLf
msg = msg & "おれぁ、そういう男よ。"
Debug.Print msg
End Sub
こいつが、Addedイベントが検知されたときに実行されるプロシージャ。
AhoesObjectという変数にぶちこまれたAhoesオブジェクトでAddメソッドが実行されると、こいつが実行されるのだ。
使ってみる
次のコードで使ってみる。
リスト１
Private Sub test02()
Dim ahoAho As AhoTest
Set ahoAho = New AhoTest
Call ahoAho.Ahoes.Add("坂田")
End Sub
AhoTestクラスのインスタンスを作成し、AhoTestクラスのAhoesプロパティでAhoesオブジェクトを取得してAddメソッドを実行する。
AhoTestクラス経由で[Ahoes].Addメソッドを実行することによって、イベントを検知してAhoesObject_Addedを実行させようという目論見。
うーむ、やっぱりわかりにくい。
よって、単純に実行結果をお目にかけるよりも、ステップ実行の様子をお目にかけた方がよかろう。
こんな感じ。
おわりに
標準モジュールでWithEventsキーワードを用いた変数宣言ができたら、もうちょっと簡単に説明ができるのだが、残念ながら標準モジュールでは不可。
『VBA Developer's Handbook Second Edition』には、
You can only use WithEvents with variables declared at the module level and only within class modules. The reason for this is that VBA uses COM to supply your project with events, and COM requires that both event generators and event listeners be objects, thus the need for class modules.
と書いてある。
尤も、上記引用文中の"class modules"にはシートモジュールも含まれるので、今回の例の場合、別にAhoTestクラスなんぞ作らずとも、シートモジュールを使えば同じことができます。
リスト２ シートモジュールに記述
Option Explicit
Private WithEvents AhoesObject As Ahoes
Private Sub test()
Set AhoesObject = New Ahoes
Call AhoesObject.Add("坂田")
End Sub
Private Sub AhoesObject_Added(ByVal AhoName As String)
Dim msg As String
msg = "アホの" & AhoName & vbCrLf
msg = msg & msg & msg & msg
msg = msg & "アホの" & AhoName & "～～～～♪" & vbCrLf
msg = msg & "おれぁ、そういう男よ。"
Debug.Print msg
End Sub
それにしても、わかりにくいなあ。
もっとわかりやすい説明が思いついたら、書き直そう。
