愚者の経験

「また今度」はほとんどこない

月別アーカイブ: 11月 2012

Access2010でのODBCDirectの代替案

Access2013はAccessProject(ADP)がサポートされないのでほぼODBCを使うことになると思います。
しかしAccess2007以降ODBCDirectは使えません。

以下の文は実行時エラー3847
「ODBCDirectはサポートされません。DAOの代わりにADOを使用するには、
コードを記述しなおしてください。」と怒られます。

        CreateWorkspace("test", "", "", dbUseODBC)

ではADOでしか外部データベースに接続できないのかというとそうでもありません。
ODBCDirectの代わりにどうやって動的(コード)で接続するかというと
TableDef、QueryDefにある「Connect」プロパティを操作することで実現可能になります。

SQLコマンドパススルー発行関数

Public Function ServerExecute(SQLString As String, Connect As String, _
                Optional ReturnsRecords As Boolean = False, _
                Optional RecordsetType As DAO.RecordsetTypeEnum = dbOpenForwardOnly, _
                Optional RecordsetOption As DAO.RecordsetOptionEnum = dbReadOnly + dbSQLPassThrough, _
                Optional StoredReturn As Boolean = False) As DAO.Recordset

    With CurrentDb.CreateQueryDef("")
        .Connect = Connect
        .SQL = SQLString
        .ReturnsRecords = ReturnsRecords
        .ODBCTimeout = 0

        If (ReturnsRecords = True) Then
            Set ServerExecute = .OpenRecordset(RecordsetType, RecordsetOption)
        Else
            If (StoredReturn = True) Then
                .ReturnsRecords = True
                .SQL = "declare @ret int" & vbCrLf & _
                    "execute @ret=" & .SQL & vbCrLf & _
                    "select @ret as Ret"
                Set ServerExecute = .OpenRecordset(RecordsetType, RecordsetOption)
            Else
                .Execute
            End If
        End If
    End With
End Function

こんなかんじにすればDatabaseオブジェクトをオープンせずに
外部データベースにコマンドを発行、結果の取得ができます。

DAO.Recordsetをフォームの「Recordset」プロパティにセットする場合はRecordsetTypeをdbOpenSnapshotに指定しないと、実行にエラー(ナンバー7965)となり
「”Recordset/レコードセット”プロパティに、そのオブジェクトは使えません」が出ます。

またテーブルのリンクを貼り直すには以下のような感じで。

Public Function TablesRelink(ByVal Connect As String) As Boolean
On Error Resume Next
        Dim tdf As TableDef
        Dim pConn As String

        ' テーブルオブジェクトをループ
        For Each tdf In CurrentDb.TableDefs
                With tdf
                        ' Connectプロパティがあるかどうかでリンクテーブルかを調べる
                        If (Nz(.Connect, "")  "") Then
                                pConn = .Connect

                                ' プログラムの接続文字列代入
                                .Connect = Connect
                                .RefreshLink

                                If (Err.Number <> 0) Then
                                        ' エラーの場合は接続文字列を元に戻す
                                        .Connect = pConn
                                        Err.Clear

                                        ' 元の接続文字列でリンク確認
                                        .RefreshLink
                                        If (Err.Number <> 0) Then
                                                TablesRelink = True
                                                Err.Clear
                                        End If
                                End If
                        End If
                End With
        Next
End Function

複数のODBCでリンクしている場合は難しいですね。
これは内部ではJET経由になるのでしょうね。

VBAから値を入れた場合にも更新系のイベントを起こす

VBAのコードからテキストボックス等に値を入れる場合、BeforeUpdateや
AfterUpdateイベントは発生しません。(正確に言うと[Value]プロパティに値を入れる、です。)
なのでそのイベントを利用している場合は代入後に各イベントを呼ぶ必要があります。

しかし、[Text]プロパティに代入するとこれらのイベントが通常通りに発生しますので便利です。
BeforeUpdateでCancelされるとエラー「2101」が発生します。
(プロパティの設定値として指定した値が正しくありません。)

Private Sub コマンド2_Click()
    Me.テキスト0.SetFocus
    Me.テキスト0.Text = "test"
End Sub

Private Sub コマンド3_Click()
    Me.テキスト0.SetFocus
    Me.テキスト0.Value = "test"
End Sub

Private Sub テキスト0_AfterUpdate()
    MsgBox "After"
End Sub

Private Sub テキスト0_BeforeUpdate(Cancel As Integer)
    MsgBox "before"
    'Cancel = True
End Sub

値を入れる側にチェックが要らなくなりますし、AfterUpdateをわざわざCallしなくても
いいので積極的に使いたいですね。
SetFocusしないと使えないのが面倒ではありますが。

EvtSummarizer改

サンプルダウンロード

前回の機能に加え以下の機能追加

・フォームとレポートもAddできるように変更
・フォームとレポートのみにあるイベントの追加
(Close,Current,Load,Unload,Resize,Activate,Deactivate追加、Closeイベントのみ確認)
・グループ化機能追加(Addの引数にGroup(String)を指定する)
・グループ名からコントロールコレクションを取得するGroupメソッド追加
・グループ名を指定し、該当するコントロールのプロパティを一斉に変更、取得する
Propertiesプロパティ追加(グループ名をNullで指定するとAddしたすべてが対象)
・KeyかIndexからKeyを取得するGetKeyメソッド追加
・KeyかIndexからGroupを取得するGetGroupメソッド追加
・Addしたコントロールをすべて消すClearメソッド追加

これで開発が楽になればいいんですが…速度が大丈夫か気になるところ。
まあよほど大量のコントロールを操作しなければUI的に遅延を感じることはほとんどないです。

追記:フォーム、レポート系のイベントを使う場合は「コード保持」プロパティを
[はい]に設定しないと使えません。

Accessでコントロールプロパティのデータバインドがしたい

Accessに足りないのはこれだと思います。プロパティのバインドが出来れば、
かなりのコードを減らすことができると思います。

バインド出来ればいいなと思うプロパティは
Visible「可視」
Enabled「使用可能」
これが筆頭だと思います。これを切り替えるために書くコードの量は馬鹿にならないと思います。

といっても前回、前々回に紹介した「EvtSummerizer」クラスを使えばさほど苦ではないのですが…一応やってみます。

Accessでコントロール配列を再現するクラス(EvtSummarizer)の使い方

EvtSummarizerで利用するとこんな感じのコードになります。 複数のコマンドボタンのダブルクリックイベントをKey付きの引数で取得します。 フォームのコード

Option Compare Database
Option Explicit

Private WithEvents btns As EvtSummarizer

Private Sub btns_EvtOnDblClick(Key As String, Cancel As Integer)
        MsgBox Key & "ダブルクリックしました。"
End Sub

Private Sub Form_Load()
        Set btns = New EvtSummarizer

        With btns
                .Add Me.コマンド0, , ehDblClick
                .Add Me.コマンド1, , ehDblClick
                .Add Me.コマンド2, , ehDblClick
                .Add Me.コマンド3, , ehDblClick

                .Remove 3

                '        
                'コントロールへのアクセス
                Debug.Print .Item(0).Name
                Debug.Print .Item(1).Name
                Debug.Print .Item(2).Name
                Debug.Print .Item(0).Caption
                Debug.Print .Item(1).Caption
                .Item(2).Tag = "test"

                Debug.Print .Item("コマンド2").Tag
        End With
End Sub

工夫している箇所 見ての通りCollectionオブジェクトと同じメソッドしか「見えません」。 コントロールのイベントを取得するEvtObjectクラスから親のEvtSummarizerクラスを参照し 親クラスの「パブリックメソッド」をCallしてRaiseEventさせるわけですが、 親クラスの「パブリックメソッド」は実際に使う際に見えてしまいます。 そこでEvtSummarizerはEvtObjectをImplementsしています。 各EvtObjectクラスは親をEvtObjectクラスにキャストして参照をもつことで「メソッドの隠蔽」を実現しています。 実際EvtObjectが「ダブルクリック」を検知し、EvtSummarizerの「ダブルクリック通知メソッド」を呼ぶ、というような仕組みでイベントと通知メソッドは基本的に一対一であるのでImplementsしても全然問題なくむしろ好都合です。 また取得したいイベントを追加する際には のようにプラス記号でずらずらと追加できます。 ちょっと.NetのAddHandlerみたいなのを意識してますw(実際はほとんどしらないです。) 内部では列挙型定数とビット計算っぽいのでいろいろやってます。CallByNameで実装しましたがフツーに場合分けで良かった気もします。 他にもEvtSummarizerのNothing時に持っているEvtObjectクラスがNothingされるようになっています。 これを実現するのが最後のクラスであるParentGuideクラスです。 参考URL:mougのクラス研究室…だったんですが削除されてます。 2013-04-19追記:kumatti様からアナウンスがありました。インターネットアーカイブで閲覧出来ます。 http://web.archive.org/web/20120512005124/http://moug.net/faq/viewtopic.php?t=62306 http://web.archive.org/web/20120512005112/http://moug.net/faq/viewtopic.php?t=62566 http://web.archive.org/web/20130115194304/http://moug.net/faq/viewtopic.php?t=62720 2番目のところに「親オブジェクトへの参照を保持せずに親オブジェクトへの参照を得る方法2」のくだりがあります。 早い話RaiseEvent-WithEvents経由でオブジェクトを伝える様にすれば、参照を持っていてもNothingされる動きになります。 それとKey文字列を持つことにしました。なのでコントロールの参照はIndex(数値)かKey(文字列)でコントロールにアクセスできます。 エラートラップしてないです…まあいいでしょう。なおKeyを入れない場合は自動的にコントロール名がKeyになります。 Indexはさり気なく0スタートです。 ぱっと思いつく要望としてはFor Eachでしょうか…あとグループ化もあるといいですね。 Itemメソッドの戻り値はObjectにしていますがControlでも良かったかなあ。でも後々FormやReportのCloseイベントとかも… コントロール配列というには少し趣旨がずれたものが完成しましたが結構快適に使えます。 「データシートのどこかのセルをダブルクリックして単票を開く」など各コントロールに同じイベントで共通メソッドを呼ぶような 場合はかなりあっさり書くことができます。また結果として同じイベントであればコントロールの種類に関係なくなっており 「テキストボックスのダブルクリック」と「ボタンのダブルクリック」なども一つのイベントでキャッチできます。(そんな機会あるかな) またサブフォームのコントロールをAddすることで処理をすべてメインフォーム側に持ってくることも可能かもしれません。 改変自由、自己責任ですが多くの方の役に立てば幸いです。試しに使ってみた方は感想いただけると嬉しいです。

Accessでコントロール配列を再現するクラス(EvtSummarizer)作成

参考URL:http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays.htm
以前の投稿でもお世話になりましたコントロール配列クラスですが、
クラスにある程度明るくなった記念に自分用に再度作りました。
自分で言うのもなんですが、結構いいものができた気がします。

コントロールのイベントを取るクラス(EvtObject)と
それらを束ねてフォーム側に通知するクラス(EvtSummarizer)の2つがあるのは変わりませんが
これに加え、コンストラクタを擬似再現するクラス(IConstractor)と
EvtObjectからEvtSummarizerを参照するクラス(ParentGuide)の4クラスで
コントロール配列クラスが完成しました。

以下がソースです。
EvtObjectクラス

Option Compare Database
Option Explicit

Implements IConstructor

Private WithEvents txt As TextBox
Private WithEvents cbo As ComboBox
Private WithEvents btn As CommandButton
Private WithEvents chk As CheckBox
Private WithEvents img As Image
Private WithEvents lbl As Label
Private WithEvents rct As Rectangle
Private WithEvents sbf As SubForm

Private Key As String
Private Guider As ParentGuide

Enum EvtHandler
    ehAfterUpdate = 1
    ehBeforeUpdate = 2
    ehChange = 4
    ehClick = 8
    ehDblClick = 16
    ehEnter = 32
    ehExit = 64
    ehKeyDown = 128
    ehMouseDown = 256
    ehMouseMove = 512
    ehMouseUp = 1024
End Enum

Private Sub Class_Terminate()
    Set txt = Nothing
    Set cbo = Nothing
    Set btn = Nothing
    Set chk = Nothing
    Set img = Nothing
    Set lbl = Nothing
    Set rct = Nothing
    Set sbf = Nothing
    Set Guider = Nothing
End Sub

Private Function IConstructor_Constructor( _
                ByVal Args As Variant) As IConstructor
On Error Resume Next
        Dim obj As Control
        Dim i As Long
        Dim EvtName As String

        Set obj = Args(0)
        Set Guider = Args(1)
        Key = Args(2)

        Select Case TypeName(obj)
                Case "TextBox": Set txt = obj
                Case "ComboBox": Set cbo = obj
                Case "CommandButton": Set btn = obj
                Case "CheckBox": Set chk = obj
                Case "Image": Set img = obj
                Case "Label": Set lbl = obj
                Case "Rectangle": Set rct = obj
                Case "SubForm": Set sbf = obj
        End Select

        For i = 0 To 10
                Select Case Args(3) And 2 ^ i
                        Case 0
                                If (Len(EvtName) <> 0) Then
                                        EvtName = ""
                                End If
                        Case 1: EvtName = "AfterUpdate"
                        Case 2: EvtName = "BeforeUpdate"
                        Case 4: EvtName = "OnChange"
                        Case 8: EvtName = "OnClick"
                        Case 16: EvtName = "OnDblClick"
                        Case 32: EvtName = "OnEnter"
                        Case 64: EvtName = "OnExit"
                        Case 128: EvtName = "OnKeyDown"
                        Case 256: EvtName = "OnMouseDown"
                        Case 512: EvtName = "OnMouseMove"
                        Case 1024: EvtName = "OnMouseUp"
                End Select

                If (Len(EvtName) > 0) Then
                        CallByName obj, EvtName, VbLet, "[イベント プロシージャ]"
                End If
        Next

        Set IConstructor_Constructor = Me
End Function

Private Property Get Parent() As EvtObject
        Set Parent = Guider.Guide
End Property

Public Sub EvtAfterUpdate(Key As String): Parent.EvtAfterUpdate Key: End Sub
Public Sub EvtBeforeUpdate(Key As String, Cancel As Integer): Parent.EvtBeforeUpdate Key, Cancel: End Sub
Public Sub EvtChange(Key As String): Parent.EvtChange Key: End Sub
Public Sub EvtClick(Key As String): Parent.EvtClick Key: End Sub
Public Sub EvtDblClick(Key As String, Cancel As Integer): Parent.EvtDblClick Key, Cancel: End Sub
Public Sub EvtEnter(Key As String): Parent.EvtEnter Key: End Sub
Public Sub EvtExit(Key As String, Cancel As Integer): Parent.EvtExit Key, Cancel: End Sub
Public Sub EvtKeyDown(Key As String, KeyCode As Integer, Shift As Integer): Parent.EvtKeyDown Key, KeyCode, Shift: End Sub
Public Sub EvtMouseDown(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single): Parent.EvtMouseDown Key, Button, Shift, X, Y: End Sub
Public Sub EvtMouseMove(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single): Parent.EvtMouseMove Key, Button, Shift, X, Y: End Sub
Public Sub EvtMouseUp(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single): Parent.EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub txt_AfterUpdate(): EvtAfterUpdate Key: End Sub
Private Sub txt_BeforeUpdate(Cancel As Integer): EvtBeforeUpdate Key, Cancel: End Sub
Private Sub txt_Change(): EvtChange Key: End Sub
Private Sub txt_Click(): EvtClick Key: End Sub
Private Sub txt_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub txt_Enter(): EvtEnter Key: End Sub
Private Sub txt_Exit(Cancel As Integer): EvtExit Key, Cancel: End Sub
Private Sub txt_KeyDown(KeyCode As Integer, Shift As Integer): EvtKeyDown Key, KeyCode, Shift: End Sub
Private Sub txt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub txt_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub txt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub cbo_AfterUpdate(): EvtAfterUpdate Key: End Sub
Private Sub cbo_BeforeUpdate(Cancel As Integer): EvtBeforeUpdate Key, Cancel: End Sub
Private Sub cbo_Change(): EvtChange Key: End Sub
Private Sub cbo_Click(): EvtClick Key: End Sub
Private Sub cbo_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub cbo_Enter(): EvtEnter Key: End Sub
Private Sub cbo_Exit(Cancel As Integer): EvtExit Key, Cancel: End Sub
Private Sub cbo_KeyDown(KeyCode As Integer, Shift As Integer): EvtKeyDown Key, KeyCode, Shift: End Sub
Private Sub cbo_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub cbo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub cbo_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub chk_AfterUpdate(): EvtAfterUpdate Key: End Sub
Private Sub chk_BeforeUpdate(Cancel As Integer): EvtBeforeUpdate Key, Cancel: End Sub
Private Sub chk_Click(): EvtClick Key: End Sub
Private Sub chk_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub chk_Enter(): EvtEnter Key: End Sub
Private Sub chk_Exit(Cancel As Integer): EvtExit Key, Cancel: End Sub
Private Sub chk_KeyDown(KeyCode As Integer, Shift As Integer): EvtKeyDown Key, KeyCode, Shift: End Sub
Private Sub chk_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub chk_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub chk_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub img_Click(): EvtClick Key: End Sub
Private Sub img_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub img_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub img_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub img_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub lbl_Click(): EvtClick Key: End Sub
Private Sub lbl_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub rct_Click(): EvtClick Key: End Sub
Private Sub rct_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub rct_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub rct_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub rct_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub btn_Click(): EvtClick Key: End Sub
Private Sub btn_DblClick(Cancel As Integer): EvtDblClick Key, Cancel: End Sub
Private Sub btn_Enter(): EvtEnter Key: End Sub
Private Sub btn_Exit(Cancel As Integer): EvtExit Key, Cancel: End Sub
Private Sub btn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseDown Key, Button, Shift, X, Y: End Sub
Private Sub btn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseMove Key, Button, Shift, X, Y: End Sub
Private Sub btn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single): EvtMouseUp Key, Button, Shift, X, Y: End Sub

Private Sub sbf_Enter(): EvtEnter Key: End Sub
Private Sub sbf_Exit(Cancel As Integer): EvtExit Key, Cancel: End Sub

コントロールを汎用的に受け入れるため冗長になりましたが…

EvtSummarizerクラス

Option Compare Database
Option Explicit

Implements EvtObject

Private EvtObjects As Collection
Private Keys As Collection

Private WithEvents Guider As ParentGuide

Public Event EvtAfterUpdate(Key As String)
Public Event EvtBeforeUpdate(Key As String, Cancel As Integer)
Public Event EvtOnChange(Key As String)
Public Event EvtOnClick(Key As String)
Public Event EvtOnDblClick(Key As String, Cancel As Integer)
Public Event EvtOnEnter(Key As String)
Public Event EvtOnExit(Key As String, Cancel As Integer)
Public Event EvtOnKeyDown(Key As String, KeyCode As Integer, Shift As Integer)
Public Event EvtOnMouseDown(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event EvtOnMouseMove(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event EvtOnMouseUp(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event EvtOnUnload(Key As String, Cancel As Integer)

Private Sub Class_Initialize()
        Set EvtObjects = New Collection
        Set Keys = New Collection
        Set Guider = New ParentGuide
End Sub

Private Sub Class_Terminate()
        Set EvtObjects = Nothing
        Set Keys = Nothing
        Set Guider = Nothing
End Sub

Private Function CreateEvtObject( _
                EventControl As IConstructor, _
                ParamArray Args() As Variant) As IConstructor
    Set CreateEvtObject = EventControl.Constructor(Args)
End Function

Public Sub Add(Target As Control, Optional Key As Variant, _
                Optional ByVal AddEventHandler As EvtHandler)
On Error GoTo Exists

        Dim oPtr As String
        Dim pKey As String

        If (IsMissing(Key)) Then
                pKey = Target.Name
        Else
                pKey = Key
        End If

        oPtr = CStr(ObjPtr(Target))

        Keys.Add Target, pKey

        EvtObjects.Add _
                CreateEvtObject(New EvtObject, _
                Target, _
                Guider, _
                pKey, _
                AddEventHandler), oPtr

        Exit Sub
Exists:
        Err.Raise 500, "EvtSummarizer", "キーは重複しないように設定してください。"
End Sub

Public Sub Remove(Index As Variant)
        If (VarType(Index) = vbString) Then
                EvtObjects.Remove CStr(ObjPtr(Keys(Index)))
                Keys.Remove Index
        Else
                EvtObjects.Remove CStr(ObjPtr(Keys(Index + 1)))
                Keys.Remove Index + 1
        End If
End Sub

Public Function Item(Index As Variant) As Object
        If (VarType(Index) = vbString) Then
                Set Item = Keys(Index)
        Else
                Set Item = Keys(Index + 1)
        End If
End Function

Public Function Count() As Long
            Count = EvtObjects.Count
End Function

Private Sub Guider_OnGuide(ParentObject As Object)
            Set ParentObject = Me
End Sub

Private Sub EvtObject_EvtAfterUpdate(Key As String): RaiseEvent EvtAfterUpdate(Key): End Sub
Private Sub EvtObject_EvtBeforeUpdate(Key As String, Cancel As Integer): RaiseEvent EvtBeforeUpdate(Key, Cancel): End Sub
Private Sub EvtObject_EvtChange(Key As String): RaiseEvent EvtOnChange(Key): End Sub
Private Sub EvtObject_EvtClick(Key As String): RaiseEvent EvtOnClick(Key): End Sub
Private Sub EvtObject_EvtDblClick(Key As String, Cancel As Integer): RaiseEvent EvtOnDblClick(Key, Cancel): End Sub
Private Sub EvtObject_EvtEnter(Key As String): RaiseEvent EvtOnEnter(Key): End Sub
Private Sub EvtObject_EvtExit(Key As String, Cancel As Integer): RaiseEvent EvtOnExit(Key, Cancel): End Sub
Private Sub EvtObject_EvtKeyDown(Key As String, KeyCode As Integer, Shift As Integer): RaiseEvent EvtOnKeyDown(Key, KeyCode, Shift): End Sub
Private Sub EvtObject_EvtMouseDown(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single): RaiseEvent EvtOnMouseDown(Key, Button, Shift, X, Y): End Sub
Private Sub EvtObject_EvtMouseMove(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single): RaiseEvent EvtOnMouseMove(Key, Button, Shift, X, Y): End Sub
Private Sub EvtObject_EvtMouseUp(Key As String, Button As Integer, Shift As Integer, X As Single, Y As Single): RaiseEvent EvtOnMouseUp(Key, Button, Shift, X, Y): End Sub

IConstructorクラス

Option Compare Database
Option Explicit

Public Function Constructor(ByVal Args As Variant) As IConstructor
        ' 擬似コンストラクタインタフェース
End Function

ParentGuideクラス

Option Compare Database
Option Explicit

Public Event OnGuide(ParentObject As Object)

Public Property Get Guide() As Object
        RaiseEvent OnGuide(Guide)
End Property

自分の中ではもはやお馴染みのIConstructorインタフェースの説明は省きますw
使い方は次回に説明します。