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
それにしても、わかりにくいなあ。
もっとわかりやすい説明が思いついたら、書き直そう。
キーワードをカッコで括るマクロ(Word)
キーワードをカッコで括るマクロ
Wordドキュメントの中に出てくるキーワードをカッコで括るマクロ。
キーワードの部分を取得する
まずは、キーワードの部分を取得しなければならない。Rangeオブジェクトとして取得すれば、あとは[Range].Textプロパティを書き換えればオッケー。
リスト１
'キーワードを検索し、ヒットした箇所のRangeオブジェクトを返すメソッド'
Private Function getNextRange( _
ByVal tgtText As String) As Range
Dim ret As Range
Set ret = Nothing
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 getNextRange = ret
End Function
おなじみFindオブジェクトを用いてキーワードを検索する。Find.Executeメソッドを実行すると、キーワードがヒットした場合、その箇所が選択された状態になる。この性質を利用して、Selection.Rangeを参照し、返ってきたRangeオブジェクトを返す。
検索でヒットしなければ、Find.FoundプロパティがFalseを返すので、その場合はNothingを返すことになる。
このメソッドを用いて取得したキーワード部分の[Range].Textプロパティをカッコ付きの文字列に書き換えてやる。
キーワード部分をカッコ付きにする
リスト２
Private Sub test00()
Const NAKED_AHO As String = "アホ"
Const AHO_WITH_BRACKET As String = "［アホ］"
Dim str1 As String, str2 As String
str1 = NAKED_AHO: str2 = AHO_WITH_BRACKET
Call clearFindObject
Dim orgRange As Range
Set orgRange = Selection.Range
Dim tgtRange As Range
Set tgtRange = getNextRange(str1)
Do While Not tgtRange Is Nothing
tgtRange.Font.NameFarEast = "ＭＳ ゴシック"
Call replaceText(str1, str2)
Set tgtRange = getNextRange(str1)
Loop
Call orgRange.Select
Call clearFindObject
End Sub
'Findオブジェクトリセット用メソッド'
Private Sub clearFindObject()
With Selection.Find
Call .ClearFormatting
Call .Replacement.ClearFormatting
End With
End Sub
'文字列置換用メソッド'
Private Sub replaceText(ByVal str1 As String, _
ByVal str2 As String)
'Findオブジェクトをクリア'
Call clearFindObject
'選択範囲を先頭方向に向かって潰す'
Call Selection.Collapse(wdCollapseStart)
Call Selection.Find.Execute(FindText:=str1, _
ReplaceWith:=str2, _
Replace:=wdReplaceOne)
'選択範囲を終端報告に向かって潰す'
Call Selection.Collapse(wdCollapseEnd)
'Findオブジェクトをクリア'
Call clearFindObject
End Sub
ドキュメント内の「アホ」を「［アホ］」に書き換えるマクロ。ついでにフォントをゴシック体に返るようにしている。
実行
このようなドキュメント（笑）を用意し、上掲のリスト２を実行する。
こんな感じ。
もちろん、「アホ」という文字列は問答無用で「［アホ］」に書き換えてしまうので、「ドリルアホールパイルドライバー」が「ドリル［アホ］ールパイルドライバー」になるというまぬけなことも起こるｗ
おわりに
鋭い方は既にお気づきのことと思うが、単に「アホ」を「［アホ］」に書き換えるだけのことなら、
Private Sub test02()
Const NAKED_AHO As String = "アホ"
Const AHO_WITH_BRACKET As String = "［アホ］"
Dim orgRange As Range
Set orgRange = Selection.Range
Call clearFindObject
With Selection.Find
Call .Execute(FindText:=NAKED_AHO, _
ReplaceWith:=AHO_WITH_BRACKET, _
Replace:=wdReplaceAll)
End With
Call clearFindObject
Call orgRange.Select
End Sub
で同じことができるんですけどねｗ
ち～んｗ
Wordドキュメント上で指定した段落以外の段落を折り畳む
Wordドキュメント上で指定した段落以外の段落を折り畳む
段落を折り畳むことができる
知らなかった。
Wordの標準機能にあった。
百聞は一見に如かず。次をご覧いただきたい。
「百聞は一見に如かず」と偉そうに言った割にはわかりにくい画像ですまないｗ
見出しスタイルを当てた段落は、左側に「・」（ポツ）が付く。
んで、このポツにカーソルを近づけると、小さな三角形が表示される。
そいつをクリックしてやると、その見出しに属する本文が折り畳まれたり、展開されたりするのだ。
こいつをVBAで操ってみる。
[Paragraph].CollapsedStateプロパティ
[Paragraph].CollapsedStateというプロパティがある。
こいつがTrueだとその見出しに属する本文が折り畳まれ、Falseだと展開される（表示される）という仕組みらしい。
ちなみに、おなじみコチラの解説によると、
Returns or sets whether the specified paragraph is currently in a collapsed state. Read/write Boolean.
とのこと。
指定した見出しスタイルに指定したキーワードが含まれている段落のみ表示するメソッド
長ったらしくて意味が取りづらくてすまぬ。
たとえば、
このようなドキュメント（笑）があったとして、たとえば、「【安倍晋三内閣総理大臣】」という見出しの段落だけを表示して、他の見出しの段落本文は折り畳んでしまおう、ということ。要するに、
こんな状態にしたい、ということ。
リスト１
Public Sub showOnlySpecifiedParagraph(ByVal tgtDocument As Document, _
ByVal styleNameKey As String, _
Optional ByVal headerKey As String)
'///指定したスタイル名の見出しの段落のみ表示し、他は折り畳む。'
'///headerKeyを指定すれば、そのキーワードを含む見出しの段落のみを表示。'
'///styleNameKey:表示する段落の見出しスタイルの名前（のキーワード）'
'///headerKey: 表示したい見出しのキーワード。'
Dim para As Paragraph
For Each para In tgtDocument.Paragraphs
With para
'段落名にstyleNameKeyが含まれていなければContinue'
If InStr(1, .Style, styleNameKey) = 0 Then GoTo Continue
'headerKeysが指定されていなければ折り畳む'
If headerKey = "" Then _
.CollapsedState = True: GoTo Continue
'段落のテキストにheaderKeyが含まれていなければ折り畳む'
If InStr(1, .Range.Text, headerKey) = 0 Then
.CollapsedState = True
Else
.CollapsedState = False
End If
End With
Continue:
Next
End Sub
処理の手順は細かくコメントを入れたので、それを見ればだいたいわかると思う。
For Each ～ Nextで全ての段落を巡回し、
段落のスタイル名にstyleNameKeyで指定したキーワードが含まれていて、なおかつその見出し段落の文字列にheaderKeyで指定したキーワードが含まれていたら、CollapsedStateプロパティをFalseにし（つまり、折り畳まない。）、それ以外のときはTrueにする（つまり、折り畳む。）
というだけのもの。
このメソッドを、先ほどの
のドキュメント（笑）に対して、次のコードで使ってみる。
リスト２
Private Sub test00()
Call showOnlySpecifiedParagraph(ActiveDocument, _
"見出し 2", _
"安倍晋三")
End Sub
スタイル名に「見出し 2」という文字列を含み、なおかつ見出しに「安倍晋三」という文字列を含む段落の本文だけを残し、他の段落の本文は折り畳む、というマクロ。
コイツを実行すると、
こうなる。
改良
しかし、上掲のshowOnlySpecifiedParagraphメソッド。困ったことに見出しのキーワードが一つしか指定できない。
つまり、たとえば先のドキュメント（笑）の場合、「議長と銭田掏次郎委員の発言だけを表示させたい」という場合には対応できないのだ。
これはイマイチ。
そこで、先の第３引数headerKeyに複数のキーワードが指定できるように改良する。
リスト３
Public Sub showOnlySpecifiedParagraph( _
ByVal tgtDocument As Document, _
ByVal styleNameKey As String, _
Optional ByRef headerKeys As Variant) '……(1)'
'///指定したスタイル名の見出しの段落のみ表示し、他は折り畳む。'
'///headerKeysを指定すれば、そのキーワードを含む見出しの段落のみを表示。'
'///styleNameKey:表示する段落の見出しスタイルの名前（のキーワード）'
'///headerKeys: 表示したい見出しのキーワード。配列か値で渡す'
'headerKeysが省略されていれば、""にする。'
If IsEmpty(headerKeys) Then headerKeys = "" '……(2)'
'headerKeysが配列でなければ、文字列にして要素数1の配列化'
If Not IsArray(headerKeys) Then '……(3)'
headerKeys = Array(CStr(headerKeys))
End If
Dim para As Paragraph
For Each para In tgtDocument.Paragraphs
With para
'段落名にstyleNameKeyが含まれていなければContinue'
If InStr(1, .Style, styleNameKey) = 0 Then GoTo Continue
'headerKeysが指定されていなければ折り畳む'
If headerKeys(0) = "" Then _
.CollapsedState = True: GoTo Continue
'段落のテキストにheaderKeyが含まれていれば折り畳まない'
If isToCollapse(.Range.Text, headerKeys) Then '……(4)'
.CollapsedState = True
Else
.CollapsedState = False
End If
End With
Continue:
Next
End Sub
Private Function isToCollapse( _
ByVal tgtHeaderText As String, _
ByRef tgtArray As Variant) As Boolean '……(5)'
isToCollapse = False
Dim i As Long
For i = LBound(tgtArray) To UBound(tgtArray)
If InStr(1, tgtHeaderText, tgtArray(i)) > 0 Then
Exit Function
End If
Next
isToCollapse = True
End Function
変更したのは(1)～(5)の５箇所。
まず(1)の
Public Sub showOnlySpecifiedParagraph( _
ByVal tgtDocument As Document, _
ByVal styleNameKey As String, _
Optional ByRef headerKeys As Variant)
で第３引数を変更。
Variantにして、文字列でも配列でも受け取れるようにした。
(2)の
If IsEmpty(headerKeys) Then headerKeys = ""
は引数チェックその１。
第３引数が省略されていたら、headerKeysを""にする。
(3)の
If Not IsArray(headerKeys) Then headerKeys = Array(CStr(headerKeys)) End If
は引数チェックその２。
配列でなかったら、値を文字列型にキャストしてheaderKeysに格納。
(4)の
If isToCollapse(.Range.Text, headerKeys) Then .CollapsedState = True Else .CollapsedState = False End If
では、折り畳むかどうかの判定にisToCollapseメソッドを用いている。Trueなら、その段落の本文は折り畳むべし、ということだ。
isToCollapseメソッドは、(5)の
rivate Function isToCollapse( _
ByVal tgtHeaderText As String, _
ByRef tgtArray As Variant) As Boolean
isToCollapse = False
Dim i As Long
For i = LBound(tgtArray) To UBound(tgtArray)
If InStr(1, tgtHeaderText, tgtArray(i)) > 0 Then Exit Function
Next
isToCollapse = True
End Function
このとおり。
引数tgtArrayの要素のうち、どれか一つでも見出し段落の文字列に含まれていたらFalse（つまり、折り畳まんでいい）を返す。
使ってみる
次のコードで実験。
リスト４
Private Sub test01()
Dim var As Variant
var = Array("銭田", "議長")
Call showOnlySpecifiedParagraph(ActiveDocument, _
"見出し 2", _
var)
End Sub
第３引数に「銭田」、「議長」という二つのキーワードを格納した配列を渡す。
コイツを実行すると、
こうなる。無事に「銭田掏次郎委員」と「議長」の発言だけを表示させ、「安倍晋三内閣総理大臣」の発言を折り畳むことができた。
おわりに
議事録なんかで、特定の出席者の発言だけを抽出したいときに便利だと思います。
自作クラスのオブジェクト型デフォルトメンバ……？？？
自作クラスのオブジェクト型デフォルトメンバ……？？？
ちょっと衝撃的な実行結果が出たので報告。
自作クラスにデフォルトメンバを設定する
これは、『VBA Developer's Handbook Second Edition』に載っていたテクニック。
VBA界隈では有名な id:t-hom さんもブログで紹介していたりする。
これをちょっとやってみたのである。
やり方は、ちょっと面倒だけれど簡単。
- クラスモジュールを一旦エクスポートする
- テキストエディタで開く
- デフォルトメンバにしたいプロシージャを選ぶ
- 当該プロシージャの先頭に、
Attribute XXXX.VB_UserMemId = 0（XXXXは、当該プロシージャの識別子）を追加して保存 - プロジェクトに戻って、インポートし直す
これでオッケー。
たとえば、PoweredSheetというクラスモジュールを次のように作成したとする。
リスト１ クラスモジュール PoweredSheet
Option Explicit Private self_ As Worksheet Public Function Self() As Worksheet Set Self = self_ End Function Public Sub init(ByVal tgtSheet As Worksheet) Set self_ = tgtSheet End Sub
モジュールレベル変数self_にWorksheetオブジェクトを持たせておいて、Selfメソッドで返す、というだけのもの。
こいつをエクスポートして、テキストエディタで次のように編集する。
リスト２ エクスポートしたPoweredSheet.cls
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True' END Attribute VB_Name = "PoweredSheet" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private self_ As Worksheet Public Function Self() As Worksheet Attribute Self.VB_UserMemId = 0 '……(*)' Set Self = self_ End Function Public Sub init(ByVal tgtSheet As Worksheet) Set self_ = tgtSheet End Sub
付け加えたのは(*)の1行のみ。
こいつを上書き保存して、もとのプロジェクトにインポートし直す。
オブジェクト ブラウザー を開いてみてみると、
Selfがデフォルトメンバになっていることがわかる。
衝撃の実行結果
問題はここから。
Selfがデフォルトメンバだとは言っても、たとえば、
Private Sub test00() Dim ps As PoweredSheet Set ps = New PoweredSheet Call ps.init(Sh01) Debug.Print ps.Name End Sub
とすれば、psだけでps.Selfのように振る舞ってくれるというわけではない。
そもそもコード入力時に
このようになる。デフォルトメンバであるSelf（Worksheet型）のメンバが自動表示されるわけでもない。
強引にたとえば「ps.Name」と入力したとて、
こうなってしまう。そもそもコンパイルが通らないという屈辱の結果。
ならば、と、
Private Sub test00() Dim ps As PoweredSheet Set ps = New PoweredSheet Call ps.init(Sh01) Dim sh As Worksheet Set sh = ps Debug.Print sh.Name End Sub
としたとしても、
実行時エラーになる。なんたる屈辱……！
秘策、発動す
そこでふと、「これ、カッコで括ったらどうなるんやろ？？？」と思い、やってみた。
リスト３
Private Sub test00() Dim ps As PoweredSheet Set ps = New PoweredSheet Call ps.init(Sh01) Dim sh As Worksheet Set sh = (ps) '……(*)' Debug.Print sh.Name End Sub
変えたのは(*)のところだけ。PoweredSheet型の変数psをカッコで括ってみた。
「カッコで括っていっぺん評価させてみたらいいんでね？」と思いついたのだ。
リスト３を実行してみると……
何ごともなく完走した上、ちゃんとSheet1とイミディエイト ウインドウに出力されている。
まるでPoweredSheetクラスのインスタンスをWorksheet型変数にほぼそのまま突っ込んだみたいになった。
おわりに
ただし、だからといって
(ps).Name
としてもダメです。
このように入力しても、行を移動した途端、
こうなりますｗ
自作クラスにオブジェクト型のデフォルトメンバを設定することは、半分可能、ということでいいのでしょうか。
私としては世紀の発見のつもりなのですが、「そんなもん常識じゃボケ！」なんでしょうか……？？？
選択部分のフィールドコードだけを表示させる(Word)
選択範囲のフィールドコードを表示させる
キーボード上での[Shift] + [ F9 ]（半角モード）をVBAで実現する方法。
これまで、[Window].[View].ShowFieldCodesプロパティのオンオフ（True/False）切り替えしか知らなかった。
ちょこちょこっと調べてみたら、選択範囲のフィールドコードだけを表示させる方法が判明したので、覚書的に記しておく。
FieldオブジェクトのShowCodesプロパティ
早い話、[Field].ShowCodesプロパティのオンオフ（True/False）を切り替えたらよい。それだけ。
リスト１
Private Sub test()
Dim tgtField As Field
Set tgtField = Selection.Fields(1)
With tgtField
.ShowCodes = Not .ShowCodes
End With
End Sub
とりあえず、選択範囲にフィールドコードがあることが前提の決め打ちコード。
フィールドコードのある部分を選択せずにこのコードを実行したら、当然実行時エラーになるので注意。
ドキュメント（笑）上で、
このようにルビが施された部分を選択して、リスト１を何度か実行。
このように、あたかも[Shift] + [ F9 ]を押したかのように、フィールドコードの表示・非表示が切り替えられる。
おわりに
ルビ情報を殺さずにフィールドコードを書き換える(＊)には、
- 一旦フィールドコードを表示させる
Find.Executeメソッドを用いてフィールドコードを置換する- 再度フィールドコードを非表示にする
という非常に面倒な操作が必要っぽいので、いちいち全てのフィールドコードを表示させなくても済む、というのは、処理速度の関係でちょっと有利になるかも知れない。いや、知らんけど。
＊
フィールドコード文字列は、[Field].Code.Textプロパティで取得することができるが、マクロでこのプロパティを書き換えることによってフィールドコードを書き換えた場合、ルビ情報が一部死ぬ。
詳しくは、
コチラをどうぞ。
