愚者の経験

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

月別アーカイブ: 2月 2012

サブクラス化+非同期処理クラスでブレーク可能に

サブクラス化で処理している間(コールバック関数内)ではブレークポイントを設定できません。
なので以前自分が作った擬似非同期処理クラスで渡してたらブレークできるんじゃ?と思ってやってみました。

結果としてはビンゴで我ながら満足した出来(^^ゞただサブクラス自体の安定性はかなり厳しい。

標準モジュールは前回の記事と同じですがメッセージ識別のために
列挙型を追加しました。

Public Enum EventHandlerEnum
    WM_CONTEXTMENU = &H7B
    WM_HSCROLL = &H114
    WM_VSCROLL = &H115
    WM_DROPFILES = &H233
    WM_CUT = &H300
    WM_COPY = &H301
    WM_PASTE = &H302
End Enum

AsyncMethodクラス(Callされる関数の引数を使うために若干の変更あり)

Option Explicit

Private html_ As Object
Private target_ As Object
Private method_ As String
Private args_ As Variant

Private Sub Class_Initialize()
    Set html_ = CreateObject(“htmlfile”)
    Set html_.parentWindow.onhelp = Me
    Set target_ = CodeContextObject
End Sub

Private Sub Class_Terminate()
    Set html_ = Nothing
    Set target_ = Nothing
End Sub

Public Property Get HasMethodObject() As Object
    Set HasMethodObject = target_
End Property

Public Property Set HasMethodObject(Value As Object)
    Set target_ = Value
End Property

Public Property Get MethodName() As String
    MethodName = method_
End Property

Public Property Let MethodName(Value As String)
    method_ = Value
End Property

Public Sub AsyncCall(ParamArray Args() As Variant)
    html_.parentWindow.setTimeout “onhelp.CallMethod”, 0, “VBScript”
    args_ = Args
End Sub

Public Sub CallMethod()
    CallByName target_, method_, VbMethod, args_
End Sub

SubClassクラス(結構変更しました。)

Option Explicit

Private target_ As Form

Private Declare Function GetWindow Lib “user32” ( _
                ByVal Hwnd As Long, _
                ByVal wCmd As Long) As Long

Private Declare Function GetWindowLong Lib “user32” _
                Alias “GetWindowLongA” ( _
                ByVal Hwnd As Long, _
                ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib “user32” _
                 Alias “SetWindowLongA” ( _
                 ByVal Hwnd As Long, _
                 ByVal nIndex As Long, _
                 ByVal dwNewLong As Long) As Long

Private Declare Function GetClassName Lib “user32” _
                Alias “GetClassNameA” ( _
                ByVal Hwnd As Long, _
                ByVal lpClassname As String, _
                ByVal nMaxCount As Long) As Long

Private Declare Function CallWindowProc Lib “user32” _
                 Alias “CallWindowProcA” ( _
                 ByVal wndrpcPrev As Long, _
                 ByVal Hwnd As Long, _
                 ByVal uMsg As Long, _
                 ByVal wParam As Long, _
                 lParam As Any) As Long
               
Private Const GWL_USERDATA = (-21)
Private Const GWL_WNDPROC = -4

Private nextproc_ As Long
Private events_ As Collection
Private async_ As AsyncMethod

Public Property Get Target() As Form
    Set Target = target_
End Property

Public Property Set Target(Value As Object)
    Set target_ = Value
End Property

Public Property Set NotifyObject(Value As Object)
    Set async_.HasMethodObject = Value
End Property

Public Property Get NotifyObject() As Object
    Set NotifyObject = async_.HasMethodObject
End Property

Public Sub AddEventHandler(EventHandler As EventHandlerEnum, _
                            Optional EventName As String = “InValidate”)
    If EventName = “” Then
        EventName = “InValidate”
    End If
    events_.Add EventName, CStr(EventHandler)
End Sub

Public Sub SubClassOn()
    SubClassOff
    SetWindowLong Target.Hwnd, GWL_USERDATA, ObjPtr(Me)
    nextproc_ = SetWindowLong(Target.Hwnd, GWL_WNDPROC, AddressOf ProcCallback)
End Sub

Public Sub SubClassOff()
    If nextproc_ Then
        SetWindowLong Target.Hwnd, GWL_WNDPROC, nextproc_
        SetWindowLong Target.Hwnd, GWL_USERDATA, 0&
        nextproc_ = 0
    End If
End Sub

Friend Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, _
                            ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo NoEventHandler
    async_.MethodName = events_(CStr(uMsg))
    If async_.MethodName = “InValidate” Then
        Exit Function
    End If
    async_.AsyncCall uMsg, wParam, lParam
NoEventHandler:
    WindowProc = CallWindowProc(nextproc_, Hwnd, uMsg, wParam, ByVal lParam)
End Function

Private Sub Class_Initialize()
    Set events_ = New Collection
    Set async_ = New AsyncMethod
End Sub

Private Sub Class_Terminate()
    SubClassOff
    Set events_ = Nothing
    Set async_ = Nothing
End Sub

使用例
フォームにサブフォームを設置

Private c As SubClass

Private Sub Form_Load()
    Set c = New SubClass
    Set c.Target = Me.テーブル1のサブフォーム.Form
    Set c.NotifyObject = Me
    c.AddEventHandler WM_VSCROLL, “VScrollMove”
    c.AddEventHandler WM_HSCROLL, “HScrollMove”
End Sub

Private Sub テーブル1のサブフォーム_Enter()
    c.SubClassOn
End Sub

Private Sub テーブル1のサブフォーム_Exit(Cancel As Integer)
    c.SubClassOff
End Sub

‘WM_VSCROLLメッセージを受け取るとここに入ります
Public Sub VScrollMove(Args As Variant)
    ‘ここではブレークできる。
    Debug.Print “縦スクロールしました。”
End Sub

‘WM_HSCROLLメッセージを受け取るとここに入ります
Public Sub HScrollMove(Args As Variant)
    ‘ここではブレークできる。
    Debug.Print “横スクロールしました。”
End Sub

SubClassのTargetはサブクラス対象のフォームで
NotifyObjectはイベントを発生させるフォームです。(AsyncMethodのTartget)

AddEventHandlerでクラス側では通知を受け取るメッセージとイベント名をCollectionに格納して
WindowProc内でCstr(uMsg)でコレクションからイベント名を引き出しAsyncCallします。
非同期処理のお陰でコールバック関数はすでに抜けているので
フォームではブレークポイントできるという目的を達成しています。

SubClass.zip
誰かの参考になれば幸いです。(各クラスコードの変更は自由です。自己責任でお使いください。)
サブクラスを利用する際はPCごとが落ちる可能性があること肝に銘じて使いましょう。

VBAでサブクラス化に挑戦 2

懲りずに今度はコールバックを最終的にクラスモジュールで処理してみます。
参考URL:http://pcdn.int21.co.jp/pcdn/vb/noriolib/vbmag/9802/subc/

SetWindowLong関数の引数で第二引数で「GWL_USERDATA」というものがあり
ここに32ビットの値を入れることができます。
参考URLと同じくクラスモジュールのインスタンスのポインタを格納し、

実際のコールバック関数内でGetWindowLongでクラスモジュールのポインタを取得

CopyMemoryで参照を取得、クラスモジュール内の関数を呼ぶ

という手順で標準モジュールにおいたウィンドウプロシージャが共用されながらも
マルチインスタンスに対応する改良をします。

標準モジュール

Option ExplicitPrivate Declare Sub CopyMemory Lib “kernel32” _
Alias “RtlMoveMemory” ( _
pDest As Any, _
pSource As Any, _
ByVal ByteLen As Long)Private Declare Function GetWindowLong Lib “user32” _
Alias “GetWindowLongA” ( _
ByVal Hwnd As Long, _
ByVal nIndex As Long) As LongPrivate Const GWL_USERDATA = (-21)Public Function ProcCallback(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim subcls As SubClass
Dim tmp As SubClass
Dim pObj As LongpObj = GetWindowLong(Hwnd, GWL_USERDATA)
CopyMemory subcls, pObj, 4
‘***2012-8-6追記
‘メモリ操作ではIUnknownインターフェイスのAddRefメソッドが
‘呼ばれない(参照カウントが増えない)ため、正しくないと
‘kumatti様からコメントいただきました。ありがとうございます。***
Set tmp = subcls ‘参照カウント増加
ProcCallback = subcls.WindowProc(Hwnd, uMsg, wParam, lParam)
CopyMemory subcls, 0&, 4
End Function

SubClassクラスモジュール

Option ExPrivate target_ As Form

Private Declare Function GetWindow Lib “user32” ( _
ByVal Hwnd As Long, _
ByVal wCmd As Long) As Long

Private Declare Function GetWindowLong Lib “user32” _
Alias “GetWindowLongA” ( _
ByVal Hwnd As Long, _
ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib “user32” _
Alias “SetWindowLongA” ( _
ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function GetClassName Lib “user32” _
Alias “GetClassNameA” ( _
ByVal Hwnd As Long, _
ByVal lpClassname As String, _
ByVal nMaxCount As Long) As Long

Private Declare Function CallWindowProc Lib “user32” _
Alias “CallWindowProcA” ( _
ByVal wndrpcPrev As Long, _
ByVal Hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Const GWL_USERDATA = (-21)
Private Const GWL_WNDPROC = -4

Private lpdefaultproc_ As Long
Private Const WM_VSCROLL = &H115

Public Property Get Target() As Form
Set Target = target_
End Property

Public Property Set Target(Form As Form)
Set target_ = Form
End Property

Public Sub SubClassOn()
SubClassOff
SetWindowLong Target.Hwnd, GWL_USERDATA, ObjPtr(Me)
lpdefaultproc_ = SetWindowLong(Target.Hwnd, GWL_WNDPROC, AddressOf ProcCallback)
End Sub

Public Sub SubClassOff()
If lpdefaultproc_ Then
SetWindowLong Target.Hwnd, GWL_WNDPROC, lpdefaultproc_
SetWindowLong Target.Hwnd, GWL_USERDATA, 0&
lpdefaultproc_ = 0
End If
End Sub

Friend Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_VSCROLL Then
Debug.Print “縦スクロールしました。”
End If
WindowProc = CallWindowProc(lpdefaultproc_, Hwnd, uMsg, wParam, ByVal lParam)
End Function

Private Sub Class_Initialize()
End Sub

Private Sub Class_Terminate()
SubClassOff
End Sub

利用例

Private subc As SubClassPrivate Sub Form_Close()
Set subc = Nothing
End SubPrivate Sub Form_Load()
Set subc = New SubClass
Set subc.Target = Me.フォーム2.Form
End SubPrivate Sub フォーム2_Enter()
subc.SubClassOn
End Sub

Private Sub フォーム2_Exit(Cancel As Integer)
subc.SubClassOff
End Sub

うまいことできました。今回はサブフォーム(フォーム2)に対してサブクラス化しています。
しかしメインフォームを指定するとやはりフリーズします…追記:うまくいったかと思ったのもつかの間、いろいろ操作したり別のプロシージャ走らせているうちにサブフォームでもフリーズすることが発覚…orz

VBAでサブクラス化に挑戦 1

サブクラス化とは「Windowからの情報(メッセージ)を先取りして処理しよう」というもので
「OSの仕組みとか詳しくない人は安易にサブクラス化しない」と説明に但し書きがあるものです。

私は詳しくない人ですが「VBAでスクロールを検知したい」という願望から
色々なページを参考に調べてみました。

参考URL:http://homepage1.nifty.com/rucio/main/tyukyu/tyukyu9.htm
失敗するとかなりやばいです。私はPCを強制終了するはめになりました…
運がよければタスクマネージャーを起動してMSACCESS.EXEのプロセス終了で持ち直せます。
どうもCPUの使用率が100%になっているっぽいです。
実験したコードは以下になります。(やってみたい人以外は実行しないでください。)
標準モジュールに以下を記述。

Option Explicit

Private Declare Function SetWindowLong Lib “user32” _
                Alias “SetWindowLongA” ( _
                ByVal Hwnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib “user32” _
                Alias “CallWindowProcA” ( _
                ByVal lpPrevWndFunc As Long, _
                ByVal Hwnd As Long, _
                ByVal Msg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const WM_VSCROLL = &H115
Dim lpprocs As New Collection

‘コールバック関数
Public Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim DefaultProc As Long

    If uMsg = WM_VSCROLL Then
        Debug.Print “縦スクロールしました。”
    End If

    DefaultProc = lpprocs(CStr(Hwnd))
    WindowProc = CallWindowProc(DefaultProc, Hwnd, uMsg, wParam, lParam)

End Function

Public Sub BeginSubClass(Target As Form)

    Dim DefaultProc As Long

    ‘サブクラス化
    DefaultProc = SetWindowLong(Target.Hwnd, GWL_WNDPROC, AddressOf WindowProc)

    lpprocs.Add  DefaultProc, CStr(Target.Hwnd)

End Sub

Public Sub EndSubClass(Target As Form)

    Dim Ret As Long
    Dim DefaultProc As Long

    DefaultProc = lpprocs(CStr(Target.Hwnd))
    Ret = SetWindowLong(Target.Hwnd, GWL_WNDPROC, DefaultProc)
    lpprocs.Remove CStr(Target.Hwnd)

End Sub

あとはフォームの「読み込み時」にBeginSubClassし、「読み込み解除時」にEndSubClassします。

大体の流れは
1.SetWindowLongでフォームにウィンドウプロシージャの設定を行う。
2.対象のフォームにメッセージが入ってくると標準モジュールのWindowProcが動作するので
  引数で動作を判定し個別に処理。
3.フォームを閉じる前にかならずウィンドウプロシージャを元に戻す。

でいいはずなんですが…どうもうまくいきません。
確かに動いていますが、しばらくするとOSごとフリーズしたような感じになります。
みなさん気をつけましょう(笑)

追記:サブフォームに対して行うとちゃんと動作しました。メインフォームだとフリーズします。

Accessでタッチパネル用アプリっぽくするために 2

「Accessでタッチパネルで操作できそうなUIを作る」の第二弾です。

今回は「ドラッグに追従するラベル」を作ります。
それだけだと前回のコードと同じなので、ドラッグの起点は前回同様のボタンということにします。

フォームにコマンドボタン「btn0」(ドラッグ起点)とラベル「lbl0」(ドラッグに追従)を配置します。

Option Explicit

Private mx As Single
Private my As Single
Private IsClick As Boolean

Private Sub btn0_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mx = X
    my = Y

    With lbl0
        .Left = btn0.Left
        .Top = btn0.Top
        .Visible = True
    End With

    IsClick = True
End Sub

Private Sub btn0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If IsClick = True Then
‘        With btn0
        With lbl0
            .Left = .Left – (mx – X)
            .Top = .Top – (my – Y)
        End With
    End If

End Sub

Private Sub btn0_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    IsClick = False
    mx = 0
    my = 0

End Sub

Private Sub Form_Load()
    lbl0.Visible = False
End Sub

「簡単だよ、前回のコードのMouseMoveイベントでbtn0をlbl0に変えればいいよ。あとMouseDown時に位置をbtn0に合わせれば一緒でしょ?」
と思って上のようなコードを思い描く人は残念!ボッシュートです(笑)。実行するとどうでしょう?
あっという間にlbl0が場外へ出てしまいます。

MouseDownのx,y座標とMouseMoveのx,y座標との差分で綺麗に移動させられるのは
座標をとったコントロールと移動するコントロールが同じときだけです。

本来はMouseMoveの座標を保持し前回と座標と今回の座標の差分だけ移動させる必要があることはなんとなく想像かつくと思います。

Private Sub btn0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If IsClick = True Then
‘        With btn0
        With lbl0
            .Left = .Left – (mx – X)
            .Top = .Top – (my – Y)
            mx = X
            my = Y
        End With
    End If
End Sub

期待する動作をするコードはこのようになります。

では前回はどうしてこう書かないかといいますと、自分自身が移動しているためにMouseMoveの引数 x,yは常に MouseDownの引数 x,y近辺の値になるのでそのようにかけます。
(差分はLeft,Topの変更で相殺され、MouseDown時の座標に戻る。)

1.  MouseDown時の引数 x,y = 100,100

2.  右に10動く[1回目](MouseMove時の引数 x,y = 110,100)→コントロールを右に10動かす。
    ※この時点でコントロールから見たカーソルの座標は x,y = 100,100
3.  右に10動く[2回目](MouseMove時の引数 x,y = 110,100) →コントロールを右に10動かす。

4.  以降繰り返し…

このような流れで動きますので、前回はコードが簡単だったのです。

サンプルコード
今回もエラー処理が入っていますので若干ここに書いたコードとは違います。

Accessでタッチパネル用アプリっぽくするために 1

「Accessでタッチパネルで操作できそうなUIを作る」をテーマにいろいろ実験、考察していきます。

今回は「ドラッグに追従するボタン」を作ります。
マウス(タッチ)でコントロールを動かすだけでもちょっとそれっぽい気がするのは私だけ?

フォームにコマンドボタン「btn0」を配置します。

Option Explicit

Private mx As Single
Private my As Single
Private IsClick As Boolean

Private Sub btn0_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mx = X
    my = Y
    IsClick = True
End Sub

Private Sub btn0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If IsClick = True Then
        btn0.Left = btn0.Left – (mx – X)
        btn0.Top = btn0.Top – (my – Y)
    End If
End Sub

Private Sub btn0_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    IsClick = False
    mx = 0
    my = 0
End Sub

上記のイベントでボタンをドラッグするとカーソルについてくるボタンができます。
結構簡単です。

カーソルに追従するボタンを作るには主に3つのイベントを用います。
「マウスボタンクリック時(MouseDown)」→ドラッグ開始
「マウスボタン移動時(MouseMove)」→ドラッグ中
「マウスボタン解放時(MouseUp)」→ドラッグ終了(ドロップ)

ボタンの位置を動かす部分では、画面の外(特に左か上)にボタンがはみ出る状態になると
実行時エラー”2100″が発生しますので実際に使う以下のように場合はエラートラップしてください。

Private Sub btn0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
    If IsClick = True Then
        btn0.Left = btn0.Left – (mx – X)
        btn0.Top = btn0.Top – (my – Y)
    End If
End Sub
ここで重要なのはタッチパネルで操作した時の挙動です。
タッチで下記サンプルを動かすと、少しボタンが遅れてついてくると思います。

サンプルプログラムをダウンロード

実はタッチの場合マウスカーソルの移動とクリックが同じタッチなのでボタンの上をタッチすると
「カーソル移動」→「クリック(MouseDown)」の2連動作を行なっています。
タッチからドラッグ移動をすぐに行うとクリックまでのタイムラグの分だけボタンの追従が遅れます。
(ものによると思いますがクリックを待とうとすると独自の「長押し」アクションが働いて
強制的にMouseUpしてしまうものもあります。)

この特性により開始地点ではあまりシビアな座標判定はしないほうがいいです。

DataGridにRecordsetのデータを表示する 1

参考URL:http://erikej.blogspot.com/2010/02/access-local-sql-compact-database-from.html

上記リンクを参考(ほとんどそのまんまなところも)にラッパークラスを書いてきたが、
AdoDataReaderの部分で詰まっています。
これは「Reader」なのでDataGridに表示まで出来ますが、そこで編集ができないです。
DataGrid上で編集するためにはDictionaryの入れ子でなく、列のプロパティを持ったクラスを
コレクションにして渡す必要がある(はず)ので、MVVMでいうViewModel(Modelかも)クラスを作って
1行ずつをViewModelクラスに変換しなくてはいけません。(これなんとかならないかな…)
さらにViewModelクラスでの変更をRecordsetに反映する必要もありますので…
考えただけでも頭が痛いです。

クラスでFor Each可能なカスタムコレクションを作る

参考URL:http://www.vb-helper.com/howto_custom_collection_with_for_each.html

以下のプロパティを持つPersonクラスを作ります。

Public Number As Integer
Public Name As String

このPersonを格納するPersonsクラスを作って

    Dim ps As Persons
~~~~~~~~~~~~~~~~~~~~~~~~
この間でpsにPersonインスタンスを格納
~~~~~~~~~~~~~~~~~~~~~~~~
Dim fp As Person
For Each fp In ps
Debug.Print fp.Number, fp.Name
Next

このようにFor EachでPersonを参照してループをすることは実は「可能」です。

次のプロシージャを見てください。

Public Sub Test()
Dim ps As Persons
Set ps = New Persons
Dim p(2) As Person

For i = 0 To UBound(p)
Set p(i) = New Person
With p(i)
.Number = i
.Name = Choose(i + 1, “佐藤”, “小林”, “鈴木”)
End With
ps.Add p(i)
Next

Dim fp As Person

For Each fp In ps
Debug.Print fp.Number, fp.Name
Next
End Sub

最後のFor EachでPersonsクラスにAddしたPersonインスタンスを追加順に取り出しています。
For Eachループが可能になるクラスの作り方を説明します。

これがPersonsクラスのソースです。

Private Col As Collection

Private Sub Class_Initialize()
Set Col = New Collection
End Sub

Public Sub Add(ByVal prsn As Person, Optional ByVal Key As String)
If Key = “” Then
Col.Add prsn
Else
Col.Add prsn, Key
End If
End Sub

Public Property Get NewEnum() As IUnknown
Set NewEnum = Col.[_NewEnum]
End Property

上半分はほぼそのまんまですので省略します。
「NewEnum」プロシージャ、Collectionの隠し関数「[_NewEnum]」がキモになります。

「NewEnum」プロパティはエクスポートしてテキストで開くと

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = Col.[_NewEnum]
End Property
このように2行目に「Attribute」がついています。

このプロシージャをこのように定義するとFor Eachループができるようになります。

ブレークして追ってみるとFor Each ステートメントの時に
この「NewEnum」に一回入っていることがわかります。
Attributeの隠し機能がどんどん出てきます(笑)
またしょーもないネタ…かと思いきや珍しく若干実用性があったり。

祝!1000アクセス

最近少しずつアクセス数が増えていて嬉しい限りです。
自分の日記帳ですが、他の皆さんのお役に立てれば幸いです。
これからもよろしくおねがいします。

最近のネタはほとんど「こうするといいよ」でなくて「これできるかな?」みたいな
非実用的なネタばかりで反省していますm(__)m

クラスモジュールにも「既定のインスタンス」

「Microsoft Access クラスオブジェクト」は標準モジュールにNewなど書いてありませんが
確かに使えています。

「クラスモジュールでもできるはずだ!標準モジュールをわざわざ作るのが不恰好だ!」
と思う人は少ないと思います(笑)。

しかし一応謎だったので調べてみました。
「フォーム1」を作成し、「コード保持」を「はい」にして「Microsoft Access クラスオブジェクト」を
作ります。

VBEから「Form_フォーム1」を右クリックして「ファイルのエクスポート」で適当に保存します。
保存したファイル(Form_フォーム1.cls)をテキストで開くと

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  ‘True
END
Attribute VB_Name = “Form_フォーム1”
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database

こんなふうになっています。なにやらたくさん「True/False」があります。

では「Class1」を作成し同じようにClass1.clsをテキストで開きます。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  ‘True
END
Attribute VB_Name = “Class1”
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database

各値が違います。

結論を言いますと

Attribute VB_PredeclaredId = False

ここをTrueにして保存しVBEでインポートすると「既定のインスタンス」持ちになります。
イミディエイトウィンドウで「Class1.」で直接メンバにアクセス可能です。

ちなみに

Attribute VB_Exposed = False

ここをTrueにするとクラスのプロパティが「2-PublicNotCreatable」になります。
その他のプロパティはいじっても反映されません。というか値が勝手に変わります。
(MutliUse=-1は未確認です。)

「既定のインスタンス」といい「既定のメンバ」といい機能はあるのにこんな設定方法しか
ないなんて…おそらく非公式なやり方でしょうから自己責任でお願いします。

既定のインスタンス

前回の記事でフォーム(レポート)でもクラスモジュールと同じく
Newによる作成(オープン)が可能であることがわかりました。

では「Docmd.OpenForm」とは何なのかということになります。
「Microsoft Access クラスオブジェクト」がクラスだとすれば
本来Newしないと使えないはずです。

ですがそのようなことを意識することなくフォームやレポートは使えます。

実は「既定のインスタンス」というのがあって「Microsoft Access クラスオブジェクト」は
何もしなくても「起動時にNewされて」いて、通常はこのインスタンスを使っています。
追記訂正:実際はもう少し違ってました。「参照された瞬間にNothingであればNewされる」かなあ。

クラスモジュールでもよく「標準モジュール」のように汎用関数を分類分けしておきたい場合に、
例えばClass1クラス内に以下のようメソッドがあって

Public Function Message1()
    MsgBox “Test1”
End Function

Public Function Message2()
    MsgBox “Test2”
End Function

標準モジュールの宣言部に

Public c As New Class1
このように書いておくと起動時に自動的にNewされるのでイミディエイトウィンドウなどで
「c.(シー、ドット)」と打ち込むとインテリセンスが働いてClass1内のメンバーを見ることができ、
実際に実行することもできます。これはインスタンスが作成されているためです。
追記訂正:ここも同様。

関数を仕分けし、直接関数名を手入力せずともインテリセンスを使えるので
これだけでもクラスモジュールを使う価値があると思っています。

参考URL:http://ameblo.jp/tech-note/theme2-10008005806.html#main