| |
'--------------------------------------------------------------------------
'値集合ソースの取得
'-------------------------------------------------------------------------
Public Function GetRowSource( _
ByVal FilterControlName As String, ByVal AddListOption As Boolean) As String
'オブジェクト変数
Dim clsElement As dbsProject1.ClsAutoFilterControlSetting
'その他の変数
Dim strRowSource As String
Dim strFilter As String
'オプションリストを追加する場合
If AddListOption Then
Let strRowSource _
= "SELECT '(すべて)', 0 FROM " & Me.TableName & VBA.vbNewLine _
& "UNION SELECT '(オプション)', 1 FROM " & Me.TableName & VBA.vbNewLine _
& "UNION "
End If
'SELECT選択列リストからWHERE句まで生成
For Each clsElement In Me.Items
'フォーカスを取得しているコントロールの場合
If clsElement.FilterControlName = FilterControlName Then
Let strRowSource _
= strRowSource _
& "SELECT DISTINCT " & clsElement.FieldName & ", 2 FROM " & Me.TableName & VBA.vbNewLine
'それ以外のコントロールでフィルタ文字列が存在する場合
ElseIf Not (Len(clsElement.Filter) = 0) Then
Let strFilter = strFilter & " AND " & clsElement.Filter
End If
Next
If Not (Len(strFilter) = 0) Then
Let strFilter = "WHERE " & Mid(strFilter, Len(" AND ") + 1) & VBA.vbNewLine
End If
'ORDER BY句を追加
Let strRowSource = strRowSource & strFilter & "ORDER BY 2, 1 " & VBA.vbNewLine
'戻り値の設定 - 値集合ソース
Let GetRowSource = strRowSource
End Function
'--------------------------------------------------------------------------
'フィルタ文字列の取得
'--------------------------------------------------------------------------
Public Function GetFilter(ByVal FilterControlName As String) As String
'オブジェクト変数
Dim clsElement As dbsProject1.ClsAutoFilterControlSetting
'その他の変数
Dim strFilter As String
'フィルタ文字列の結合
For Each clsElement In Me.Items
If Not (Len(clsElement.Filter) = 0) Then
Let strFilter = strFilter & " AND " & clsElement.Filter
End If
Next
Let strFilter = Mid(strFilter, Len(" AND ") + 1)
'戻り値の設定 - フィルタ文字列
Let GetFilter = strFilter
End Function
'--------------------------------------------------------------------------
'条件指定用コントロールのフォーカス取得後
'--------------------------------------------------------------------------
Public Function EvtFilterControlGotFocus(ByVal FilterControl As Access.Control) As Long
'フォーカスを取得しているコントロールの設定
Set Me.CurrentFilterControl = FilterControl
Let Me.CurrentFilterControl.RowSource _
= Me.GetRowSource(FilterControlName:=Me.CurrentFilterControl.Name, AddListOption:=True)
Let FilterControl.RowSource = Me.CurrentFilterControl.RowSource
End Function
'--------------------------------------------------------------------------
'条件指定用コントロールの更新後処理
'--------------------------------------------------------------------------
Public Function EvtFilterControlAfterUpdate(ByVal FilterControl As Access.Control) As Long
Dim clsElement As dbsProject1.ClsAutoFilterControlSetting
Set clsElement = Me.Items(Index:=FilterControl.Name)
Set Me.CurrentFilterControl = FilterControl
'リストの選択内容で処理を分岐
Select Case Me.CurrentFilterControl.ListIndex
'(すべて)または非選択
Case Is < 1
'フィルタ文字列と値のクリア
Let clsElement.Filter = ""
Let clsElement.FilterValues1 = Null
Let clsElement.FilterValues2 = Null
'(オプション)
Case Is = 1
'オートフィルタオプションダイアログを開く
DoCmd.OpenForm FormName:=cAutoFilterOptionDialogName, OpenArgs:=Me.MainForm.Name
'その他の項目
Case Else
'フィルタ文字列の設定
Let clsElement.Filter _
= Application.BuildCriteria( _
Field:=clsElement.FieldName _
, FieldType:=clsElement.FieldType _
, Expression:="=" & Me.CurrentFilterControl.Value)
'値および比較方法の再設定
Let clsElement.FilterValues1 = Me.CurrentFilterControl.Value
Let clsElement.FilterValues2 = Null
Let clsElement.FilterCompare1 = 1 '[と等しい]
Let clsElement.FilterCompare2 = 0 '[空欄]
End Select
'結果表示用フォームにフィルタ適用
Let Me.DisplayForm.Filter = Me.GetFilter(FilterControlName:=Me.CurrentFilterControl.Name)
Let Me.DisplayForm.FilterOn = True
End Function
|
|
チャラ
- 05/10/29(土) 23:41 -
