| |
＜つづき２＞
---------------------------------------------------------------------------
クラスモジュール[ClsAutoFilterSetting]
---------------------------------------------------------------------------
Option Compare Database
Option Explicit
'--------------------------------------------------------------------------
'プロパティ値保存用定数
'--------------------------------------------------------------------------
Private Const cAutoFilterOptionDialogName As String = "FrmAutoFilterOption"
Private Const cProcedureNameOnGotFocus As String = "=EvtFilterControl_OnGotFocus()"
Private Const cProcedureNameAfterUpdate As String = "=EvtFilterControl_AfterUpdate()"
'--------------------------------------------------------------------------
'プロパティ値保存用オブジェクト変数
'--------------------------------------------------------------------------
Private mAutoFilterControlSettingCollection As VBA.Collection
'--------------------------------------------------------------------------
'プロパティ値保存用変数
'--------------------------------------------------------------------------
Private mCurrentFilterControl As Access.Control 'フォーカスを取得しているコントロール
Private mDisplayForm As Access.Form '結果表示用フォーム
Private mMainForm As Access.Form '条件指定用フォーム
Private mRowSourcePreFix As String 'オプションリスト文字列
'--------------------------------------------------------------------------
'クラス作成時イベントプロシージャ
'-------------------------------------------------------------------------
Private Sub Class_Initialize()
Set mAutoFilterControlSettingCollection = New VBA.Collection
End Sub
'--------------------------------------------------------------------------
'クラス終了時イベントプロシージャ
'--------------------------------------------------------------------------
Private Sub Class_Terminate()
Set mAutoFilterControlSettingCollection = Nothing
End Sub
'--------------------------------------------------------------------------
'プロパティの値を取得 - フォーカスを取得しているコントロール
'--------------------------------------------------------------------------
Public Property Get CurrentFilterControl() As Access.Control
Set CurrentFilterControl = mCurrentFilterControl
End Property
'--------------------------------------------------------------------------
'プロパティに値を設定 - フォーカスを取得しているコントロール
'--------------------------------------------------------------------------
Public Property Set CurrentFilterControl(ByVal pCurrentFilterControl As Access.Control)
Set mCurrentFilterControl = pCurrentFilterControl
End Property
'--------------------------------------------------------------------------
'プロパティの値を取得 - 条件指定用フォーム
'--------------------------------------------------------------------------
Public Property Get MainForm() As Access.Form
Set MainForm = mMainForm
End Property
'--------------------------------------------------------------------------
'プロパティに値を設定 - 条件指定用フォーム
'--------------------------------------------------------------------------
Public Property Set MainForm(ByVal pMainForm As Access.Form)
Set mMainForm = pMainForm
End Property
'--------------------------------------------------------------------------
'プロパティの値を取得 - 結果表示用フォーム
'--------------------------------------------------------------------------
Public Property Get DisplayForm() As Access.Form
Set DisplayForm = mDisplayForm
End Property
'--------------------------------------------------------------------------
'プロパティに値を設定 - 結果表示用フォーム
'--------------------------------------------------------------------------
Public Property Set DisplayForm(ByVal pDisplayForm As Access.Form)
Set mDisplayForm = pDisplayForm
End Property
'--------------------------------------------------------------------------
'プロパティの値を取得 - テーブル名 [読み取り専用]
'--------------------------------------------------------------------------
Public Property Get TableName() As String
Let TableName = Me.DisplayForm.Form.RecordSource
End Property
'--------------------------------------------------------------------------
'コレクションに要素を追加
'------------------------------------------------------------------------
Public Function Append( _
ByVal FilterControlName As String _
, ByVal FieldName As String _
, ByVal FieldType As Long) As dbsProject1.ClsAutoFilterControlSetting
Dim clsElement As dbsProject1.ClsAutoFilterControlSetting
Set clsElement = New dbsProject1.ClsAutoFilterControlSetting
With clsElement
.FilterControlName = FilterControlName
.FieldName = FieldName
.FieldType = FieldType
End With
mAutoFilterControlSettingCollection.Add Item:=clsElement, Key:=FilterControlName
Set Append = clsElement
Set clsElement = Nothing
End Function
'--------------------------------------------------------------------------
'コレクションの要素を取得(1)
'-------------------------------------------------------------------------
Public Function Items() As VBA.Collection
Set Items = mAutoFilterControlSettingCollection
End Function
'--------------------------------------------------------------------------
'コレクションの要素を取得(2)
'--------------------------------------------------------------------------
Public Function Item(ByVal Index As Variant) As dbsProject1.ClsAutoFilterControlSetting
Set Item = Me.Items(Index:=Index)
End Function
'--------------------------------------------------------------------------
'プロパティの初期化
'-------------------------------------------------------------------------
Public Function PropertyInitialize( _
ByVal MainForm As Access.Form _
, ByVal DisplayForm As Access.Form _
, ByVal rstRecordSource As DAO.Recordset) As Long
'オブジェクト変数
Dim ctl As Access.Control
'プロパティの設定(1)
Set Me.MainForm = MainForm
Set Me.DisplayForm = DisplayForm
'プロパティの設定(2)
For Each ctl In Me.MainForm.Section(acHeader).Controls
If Not (Len(ctl.Tag) = 0) Then
Select Case ctl.ControlType
Case acComboBox, acListBox
Me.Append _
FilterControlName:=ctl.Name, FieldName:=ctl.Tag _
, FieldType:=rstRecordSource.Fields(ctl.Tag).Type
Let ctl.OnGotFocus = cProcedureNameOnGotFocus
Let ctl.AfterUpdate = cProcedureNameAfterUpdate
End Select
End If
Next
End Function
|
|
チャラ
- 05/10/29(土) 23:38 -
