isAutoFilteredメソッドの修正
isAutoFilteredメソッドの欠陥
isAutoFilteredメソッドとは
自作のFunction。
このときに作ったもの。
こんなふうにフィルターで絞り込まれていないときにFalseを返す。
イミディエイト・ウインドウに
?isAutoFiltered(Sheet1)
と入力して[Enter]を押すと、
このとおり。
こんなふうに、フィルターで絞り込まれていると、Trueを返す。
このとおり。
重大な欠陥
しかし、このisAutoFilterメソッドには、重大な欠陥があったのだった。
AutoFilterオブジェクトのことが分かっている方は、すでにお気づきだったかと思うが、たとえば、
この状態のワークシートを指定して
実行しようと[Enter]を押すと、
実行時エラーになる。
理由は簡単。
そもそもAutoFilterオブジェクトが存在しないのに参照しようとしたからだ。
今でこそエラーメッセージを見た瞬間、このことに気づけたけれど、初心者の頃だったらこれだけで小一時間はハマっていたと思うｗ
というわけで、コードを修正した。
修正後のコード
リスト１ 標準モジュール
Public Function isAutoFiltered(Optional ByVal targetSheet As Worksheet) As Boolean
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
With targetSheet
If .AutoFilter Is Nothing Then isAutoFiltered = False: Exit Function '……(*)'
If .AutoFilter.FilterMode Then isAutoFiltered = True: Exit Function
End With
isAutoFiltered = False: Exit Function
End Function
変えたのは、基本的には(*)のところだけ。
対象のワークシートにAutoFilterオブジェクトがなかったらFalseをreturnして処理を抜ける、というだけ。
使ってみる
改めて[Enter]！
ちゃんとFalseが返った。
おわりに
フィルターを設定した状態で作成したFunctionだったので、フィルターを外した状態での実験が完全に抜けていた。とらわれるとやはり見落とすことが多いものです。
半角カタカナを全角ひらがなに変換する（StrConv関数）
半角カタカナと戦う（StrConv関数）
名簿のふりがな欄
いろんな名簿を作る必要があって、着手してから気がついた。
名簿のふりがな欄、ふりがなの付け方めちゃくちゃやんけ！
ある名簿は全角ひらがな。またある名簿は半角カタカナ。
んで、StrConv関数を使ってみた。
半角カタカナを全角ひらがなにできるか
やってみた。
イミディエイト・ウインドウに、
?StrConv("ﾗﾙﾌ･ﾌﾞﾗｲｱﾝﾄ",vbHiragana)
と入力して[Enter]！
全然ダメｗｗｗ
半角カタカナを全角カタカナにできるか
こんどは、
?StrConv("ﾗﾙﾌ･ﾌﾞﾗｲｱﾝﾄ",vbWide)
と入力して[Enter]！
おお！ 半角カタカナから全角カタカナというのはできるようだ。ありがたい。
ちゃんと「ﾌﾞ」（２文字）が「ブ」（１文字）になっとるし。
一旦全角カタカナにしてから全角ひらがなへ
全角カタカナから全角ひらがなならフツーにできると思うので、
?StrConv(StrConv("ﾗﾙﾌ･ﾌﾞﾗｲｱﾝﾄ",vbWide),vbHiragana)
これで大丈夫のはず。
[Enter]！
やはり。
半角カタカナを全角ひらがなに変換するFunction
作ってみた。
リスト１ 標準モジュール
Public Function convertSingleByteKatakanaToDoubleByteHiragana _
(ByVal targetString As String) As String
Dim tmp As String
tmp = StrConv(targetString, vbWide)
tmp = StrConv(tmp, vbHiragana)
convertSingleByteKatakanaToDoubleByteHiragana = tmp
End Function
プロシージャ名が無駄に長い。
まあ、いったん全角文字に変えてから、ひらがなに変換してreturnしているだけの簡単なFunction。
使ってみた
イミディエイト・ウインドウに
?convertSingleByteKatakanaToDoubleByteHiragana("ﾌﾗﾝｼｽ･ﾌﾞｯﾌﾎﾙﾂ")
と入力して[Enter]！
ほれ、この通り。
おわりに
半角カタカナを全角カタカナに変換できるんなら、半角カタカナを直接全角ひらがなに変換できても良さそうなものだけれど、〈半角→全角〉、という処理と〈カタカナ→ひらがな〉という処理を分けておくことに意義があるのでしょうなあ。
Document_Closeイベントで差込データソースとの接続を切断する
Document_Closeイベントの挙動
差し込み印刷の設定をしているドキュメントは、一旦閉じると、次回起動時に自動的に前回接続していたデータソースに接続しようとする。
これはこれで親切機能なのだが、何も知らない人が差し込み設定をしたドキュメントを別のフォルダに移動したりした日には大パニックが起こること必定であるｗ
また、差し込み設定のことがよく分かっている人間でも、たとえば前年度のものを使い回すのにフォルダごと移動したようなとき、その都度差し込み設定をやり直すのはちょいメンドクサイ。
そんなこともあって、
こういうのを作ったわけだが、実はコレも不十分だった。
Openイベントで一旦接続を切るようにしたとしても、Openイベントが発生する前にデータソースを探しに行っているっぽいので、全然解決になっていないことに気づいたのだ。
これはやはりCloseイベントで対応しないといけないと分かった。
ドキュメントClose時にデータソースを切断するイベントマクロ
細かい説明は後にして、とりあえずの完成形を示す。
リスト１ ThisDocumentモジュール
Private Sub Document_Close()
Dim Doc As Document
Set Doc = ThisDocument
With Doc
If .Saved Then '……(1)'
Call disconnectMailMergeDataSource(Doc) '……(2)'
.Save '……(3)'
Else
Call disconnectMailMergeDataSource(Doc) '……(4)'
End If
End With
End Sub
まず、(1)からの６行
If .Saved Then Call disconnectMailMergeDataSource(Doc) '……(2)' Call .Save '……(3)' Else Call disconnectMailMergeDataSource(Doc) '……(4)' End If
では、ドキュメントのSavedプロパティによって条件分岐している。
SavedプロパティがTrue、すなわち既に上書き保存された状態であれば、(2)の
Call disconnectMailMergeDataSource(Doc)
で、まずdisconnectMailMergeDataSourceメソッドを呼んで接続をぶった切る。
ちなみに、disconnectMailMergeDataSourceメソッドのコードはコチラ。
で、(3)の
Call .Save
で再度上書き保存をする。ドキュメントClose時点で上書き保存済みであり、その後の変更はデータソースの切断だけなので、再度上書き保存してもユーザーに不利益は生じないはず。これでデータソースが切断された状態で保存されているはずだ。
で、SavedプロパティがFalseのとき、すなわち上書き保存せずにドキュメントCloseしようとしたときにも(4)の
Call disconnectMailMergeDataSource(Doc)
でデータソースをぶった切っている。
なぜこんなことが必要なのか。
次の画像を見てほしい。
SavedプロパティがFalseの状態、すなわち変更を保存していない状態でドキュメントを閉じようとしてみる。
上書き保存をせずに（すなわちSavedプロパティがFalseの状態で）Document_Closeイベントが発生すると、このような順でプロシージャが実行され、そのあとで
コイツが出てくるのだ。
つまり、もしCloseイベントの中でデータソースをぶった切っておかないと、上書き保存確認ダイアログで[保存]を選んだ場合にデータソースに接続された状態で保存されてしまうわけ。
おわりに
これで少なくともWord2013では「常に差込データソースを切断した状態に保つ」ことができるようになった。
ただ、職場のWord2010だと、Closeイベント内で 切断→上書き保存 をしても、接続状態なんだよなあ……。
「標準モジュール」とは何ものなのか
「標準モジュール」とは何ものなのか
割と最近まで、「標準モジュール」というのは、単に【コードを書く場所】ぐらいの雑なとらえ方で済ませていた。
しかし、「クラスモジュール」とか、「フォームモジュール」、「シートモジュール」、「ThisWorkbookモジュール」などを使い分けていくうちに、改めて「標準モジュールとは何ものなのか」という疑問が生じたわけである。
標準モジュールはNewできない
たとえば、標準モジュールを挿入し、オブジェクト名を「Foobar」とする。
で、こいつをNewしようとすると、
「不正」呼ばわりｗ
標準モジュールというものは、「オブジェクト」ではあるものの、インスタンス化はできない模様。
ちなみに、FormモジュールはNewできる。
静的（static）クラスっぽい？
インスタンス化できない、といえば、静的クラスみたいなもんだろうか。
ちょっとメソッドを持たせてみる。
リスト１ 標準モジュール「Foobar」
Option Explicit Public Sub hoge() Call makeUserSick("ホゲーーー♪") End Sub Private Sub fuga() Call makeUserSick("ふがふが") End Sub
※makeUserSickメソッドのコードはコチラ。
PublicメソッドとPrivateメソッドをそれぞれ１つづつ持たせてみた。
Publicメソッドだと、
Foobar.hoge
とモジュール名を書かなくても、
hoge
だけで呼び出せてしまって、イマイチ。
もし、
このときのように、モジュール名を指定すればPrivateメソッドでも実行できるとなれば便利だと思った。
次のコードで実行してみた。
テストコード 標準モジュール「Module1」
Public Sub testFoobar() Call hoge Call fuga End Sub
これは、当然
エラーになる。当たり前だ。
次は、Privateなfugaメソッドにモジュール名を指定してみる。
テストコード 標準モジュール「Module1」
Public Sub testFoobar() Call hoge Call Foobar.fuga End Sub
コーディング中にintellisenseが働かないのはあのときと同じなので気にしない。
すると、
アチャー、ダメかｗ
残念！
モジュール名を指定しないと使えない、とかだったら便利だと思ったんだけどなあ。
ならばクラス（Static）変数はどうか
標準モジュールでもPropertyを持たせることができるので、クラス変数的なものは持たせられるのではないか、と考えた。
リスト１に次のようにコードを追加する。
リスト２ 標準モジュール「Foobar」
Option Explicit Private Foo_ As Integer Public Property Let Foo(ByVal bar As Integer) Foo_ = bar End Property Public Property Get Foo() As Integer If Foo_ = 0 Then Foo_ = 1 Foo = Foo_ End Property Public Sub hoge() Call makeUserSick("ホゲーーー♪" & " Fooプロパティは「" & Foo & "」やでｗ") Foo_ = Foo_ + 1 End Sub Public Sub fuga() Call makeUserSick("ふがふが" & " Fooプロパティは「" & Foo & "」やでｗ") Foo_ = Foo_ + 1 End Sub
Fooというプロパティを設定し、hoge、fugaメソッドを実行するたびにFooプロパティをインクリメントする。
たったこれだけ。Fooプロパティの値は、hoge、fugaメソッド実行時に表示されるようにしてある。
んで、次のコードを何度か実行してみる。
テストコード 標準モジュール「Module1」
Public Sub testFoobar() Call Foobar.hoge Call Foobar.fuga End Sub
実行１回目
Fooプロパティは、「2」になっている。
実行２回目
再度実行してみる。
FoobarのFooプロパティは、testFoobarプロシージャの実行終了後も値を保持し続けている。
クラス変数っぽいといえばクラス変数っぽいけれど、そもそもインスタンス化できないのだから、何に役立つのか分からないｗ
ちなみに、オブジェクト名「Room」というクラスモジュールの宣言セクションに「numberOfRooms」というPublic変数を置いて、
Dim r As New Room Debug.Print Room.numberOfRooms
と書いたとしても、実行すると
無情にもコンパイル・エラーになる。
まとめ
およそ、次のようなことが分かった。
- 標準モジュールはNewできない。
- モジュール名を指定してもPrivateメソッドは別モジュールから呼び出せない。
- プロパティを持たせることで、クラス（static）変数っぽいことはできる。
- クラスモジュールではクラス（static）変数を持たせることができない。
おわりに
「標準モジュール」、「クラスモジュール」ともに一長一短があるんだよなあ……。
配列変数を値渡しにする
値渡しの配列引数
配列引数を値渡しにする方法
このときにも書いたとおり、通常、プロシージャの引数に配列を渡すとき、
Public Sub hogehoge(ByVal foo() As String)
みたいにすると、
こんなエラーが出る。
ところが、VBA四天王（だから、内わけはどうなっとるんだよｗ）の一人、id:imihito さん曰く、
引数の型をVariant型にすると、配列も値渡しで受け取ることができたりします
とのこと。
さらに、
オブジェクト型配列だと型情報が抜ける
とも。
へえ。いっぺんやってみよう。
Variant型引数にオブジェクト型の配列を渡してみる
メンドクサイので、２ついっぺんにやってみる。
リスト１ 標準モジュール
Public Sub testDeclareObjectArgByVal()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Sheet1")
Dim vtlTable(1) As New VirtualTable
vtlTable(0).init Sh.Range("A1").CurrentRegion '……(1)'
vtlTable(1).init Sh.Range("J1").CurrentRegion
Call returnValue(vtlTable) '……(2)'
End Sub
Private Sub returnValue(ByVal targetVirtualTable As Variant) '……(3)'
Dim i As Integer
For i = LBound(targetVirtualTable) To UBound(targetVirtualTable) '……(4)'
Debug.Print targetVirtualTable(i).valueOfCell(2, 2)
Next
Debug.Print TypeName(targetVirtualTable) '……(5)'
End Sub
せっかくなので、
前回リニューアルしたVirtualTableクラス型の配列を使ってやってみた。
VirtualTableクラスのコードについてはコチラをどうぞ。
こんな表を用意して、
(1)からの２行
vtlTable(0).init Sh.Range("A1").CurrentRegion
vtlTable(1).init Sh.Range("J1").CurrentRegion
で、initメソッドを用いて、Ａ１セルのCurrentRegionをvtlTable(0)に、Ｊ１セルのCurrentRegionをvtlTable(1)に渡してそれぞれ初期化する。
(2)の
Call returnValue(vtlTable)
では、引数にVirtualTableクラス型の配列変数vtlTableを渡してreturnValueプロシージャを呼び出している。
returnValueプロシージャは、(3)からの７行
Private Sub returnValue(ByVal targetVirtualTable As Variant) '……(3)'
Dim i As Integer
For i = LBound(targetVirtualTable) To UBound(targetVirtualTable) '……(4)'
Debug.Print targetVirtualTable(i).valueOfCell(2, 2)
Next
Debug.Print TypeName(targetVirtualTable) '……(5)'
End Sub
(3)の
Private Sub returnValue(ByVal targetVirtualTable As Variant)
で、引数の型をVariant型にして、ByValキーワードを付けている。
見た目上、値渡しになっているが、その反面、見た目上は引数targetVirtualTableが配列変数だとは全く分からない。
このプロシージャ内では、まず(4)からの３行
For i = LBound(targetVirtualTable) To UBound(targetVirtualTable) Debug.Print targetVirtualTable(i).valueOfCell(2, 2) Next
で、VirtualTableクラスのインスタンスそれぞれが内部で保持している２次元配列（元は表）の２行２列目の値をイミディエイトに書き出し、それが終わったら、(5)の
Debug.Print TypeName(targetVirtualTable)
で、TypeName関数を用いて、引数として受け取ったtargetVirtualTableの型名をイミディエイトに出力する、という至って投げやりな処理を行う。
実行結果
おお！ ３行目が「Object()」になっとる！
たしかに、もともとVirtualTable型であったという情報は失われているっぽい。
おわりに
この他にも、呼び出され側のプロシージャ（今回の場合はreturnValueプロシージャ）をコーディングするとき、targetVirtualTableの型が未確定なため、Intellisenseが全く効かず、非常に書きにくかった、ということも申し添えます。
わざわざ値渡しにする意義が今ひとつ見いだせなかった。
VirtualTableクラスは今
VirtualTableクラスは今
VirtualTableクラスの現状
VLOOKUPにせよ、INDEX & MATCHの合わせ技にせよ、セルに数式がずらずらと書き込まれているというのはちょっとイヤなので、表引きは極力VBAでやっている。
んで、VLOOKUPみたいな働きを持ったクラスを作ったのが
このときの試み。
いろいろと使っていくうちに、今こんなふうになっている、というのをうｐしておくことにした。
リスト１ クラスモジュール
オブジェクト名は「VirtualTable」。
Option Explicit
Private Type Exception
Number_ As Integer
Discription_ As String
End Type
Private Const NUM_NOT_INIT As Integer = 10001
Private Const DISCRIPT_NOT_INIT As String = _
"VirtualTableクラスのinitメソッド未実行"
'Member Variable'
Private thrownException10001 As Exception
Private isInitialized_ As Boolean
Private tableArray_ As Variant
Private rowsCount_ As Long
Private columnsCount_ As Long
'Accessor'
Public Property Get rowsCount() As Long
If Not isInitialized_ Then Call catchException(thrownException10001)
rowsCount = rowsCount_
End Property
Public Property Get columnsCount() As Long
If Not isInitialized_ Then Call catchException(thrownException10001)
columnsCount = columnsCount_
End Property
Public Property Get valueOfCell(ByVal rowIndex As Long, _
ByVal columnIndex As Long) As Variant
On Error GoTo errorHandler
If Not isInitialized_ Then Call catchException(thrownException10001)
valueOfCell = tableArray_(rowIndex, columnIndex)
Exit Property
errorHandler:
valueOfCell = False
End Property
'Constructor'
Private Sub Class_Initialize()
With thrownException10001
.Number_ = NUM_NOT_INIT
.Discription_ = DISCRIPT_NOT_INIT
End With
End Sub
Public Sub init(ByVal targetTableRange As Range)
On Error GoTo errorHandler
tableArray_ = targetTableRange.Value
rowsCount_ = UBound(tableArray_, 1)
columnsCount_ = UBound(tableArray_, 2)
isInitialized_ = True
Exit Sub
errorHandler:
End Sub
'Method'
Public Function searchValueVertical( _
ByVal searchFor As Variant, _
Optional ByVal searchColumn As Long = 1, _
Optional ByVal returnValueColumn As Long = 1) As Variant
On Error GoTo errorHandler
If Not isInitialized_ Then Call catchException(thrownException10001)
Dim i As Long
Dim tmp As Variant
For i = 1 To rowsCount_
tmp = tableArray_(i, searchColumn)
If tmp = searchFor Then
searchValueVertical = tableArray_(i, returnValueColumn)
Exit Function
End If
Next
errorHandler:
searchValueVertical = False
End Function
Private Sub catchException(ByRef thrownException As Exception)
With thrownException
Call Err.Raise(Number:=.Number_, _
Description:=.Discription_)
End With
End Sub
大きく変えたのは、initメソッド未実行のときにエラーを吐くようにしたところですかね。
エラー情報の管理のために無駄に構造体を使ってみたりもしています。
現時点での仕様
プロパティ
rowsCount（Long型）
メンバ変数tableArray_として保持している表（正体は２次元配列）の行数。
columnsCount（Long型）
メンバ変数tableArray_として保持している表（正体は２次元配列）の列数。
valueOfCell（Variant型）
メンバ変数tableArray_として保持している表（正体は２次元配列）のrowIndex行columnIndex列の値。
メソッド
init
式.init(targetTableRange)
引数targetTableRangeには、Range型の表を指定する。
searchValueVertical
式.searchValueVertical(searchFor, [searchColumn], [returnValueColumn])
引数searchForには、検索したい値をVariant型で指定する。
引数searchColumn（省略可）には、検索値を検索する対象の列番号をLong型で指定する。デフォルト値は「1」。
引数returnValueColumn（省略可）には、検索値が見つかったときに、検索値のあった行のどの列の値を返すのかをLong型で指定する。デフォルト値は「1」。
返り値はVariant型。表の指定した列（searchColumn列）の値を上から順に調べ、最初にsearchForとマッチした行の指定した列（returnValueColumn列）の値を返す。
検索値がヒットしなかった場合、または検索時にエラーとなった場合（存在しない列を指定するなど）には、Falseが返る。
おわりに
便利な機能を追加したいけど、アイディアがない。
配列を引数にするときの注意
配列を引数にするときの注意事項
配列引数はByRefでなければなりません
SubとかFunctionの引数に配列を使用しようとしたとき、「ByVal」キーワードを付けると、
こんなふうにコンパイル・エラーになる。
従って、引数を配列にしたときには必然的に参照渡しになってしまう、ということだ。
配列を加工して返すFunctionを使用した場合
……ということは、配列を受け取って、加工して返すようなFunctionを使用した場合、もはや元の（加工前の）配列は存在しない、ということなのだろうか。
やってみた
次のコードで実験。
リスト１ 標準モジュール
Public Sub testTemperArray()
Dim ar(3) As String
ar(0) = "アホ"
ar(1) = "ボケ"
ar(2) = "クズ"
ar(3) = "デコスケ"
Dim el As Variant
Debug.Print "【arの要素書き出し】"
For Each el In ar '……(1)'
Debug.Print el
Next
Dim ar2() As String
ar2 = temperArray(ar) '……(2)'
Debug.Print "【ar2の要素書き出し】"
For Each el In ar2 '……(3)'
Debug.Print el
Next
Debug.Print "【再びarの要素書き出し】"
For Each el In ar '……(4)'
Debug.Print el
Next
End Sub
Private Function temperArray(ByRef targetArray() As String) As String()
targetArray(2) = "ＫＡＳＵ"
temperArray = targetArray
End Function
「temper」というのは、今はやりの「改竄する」という意味ｗ
受け取った配列の第３要素を「ＫＡＳＵ」というイカしたローマ字に改竄して返すプロシージャだ。
まず、冒頭で作成したarという要素数4の配列について、(1)からの３行
For Each el In ar Debug.Print el Next
で、For Eachを使って全要素をイミディエイトに書き出す。
次に、(2)の
ar2 = temperArray(ar)
で、バカ丸出しのFunctionプロシージャ「temperArray」に配列arを渡して、返り値をar2にぶち込む。
そして、(3)からの３行
For Each el In ar2 Debug.Print el Next
で、ar2の要素をイミディエイトに書き出す。
あとは、(4)からの３行
For Each el In ar Debug.Print el Next
で、再度arの全要素をイミディエイトに書き出す。
実行結果
arを引数として渡して加工したときに、arそのものが加工されてしまったっぽい。まさに参照渡し。
おわりに
気をつけないといけないなあ。
