Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6520 / 9994

←次へ　｜　前へ→


	【6677】コンボボックスでの検索方法（６）

チャラ - 05/10/29(土) 23:49 -


	引用なし

	パスワード

'-----------------------------------------------------------------------------------------------
'コンボボックス [値(条件2)] - 更新後処理イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub CmbValues2_AfterUpdate()

'値(条件2)の設定を更新
With Me.AutoFilterSetting
.Item(.CurrentFilterControl.Name).FilterValues2 = Me.CmbValues2.Value
End With
End Sub

'-----------------------------------------------------------------------------------------------
'コンボボックス [比較方法(条件1)] - 更新後処理イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub CmbCompare1_AfterUpdate()

'比較方法(条件1)の設定を更新
With Me.AutoFilterSetting
.Item(.CurrentFilterControl.Name).FilterCompare1 = Me.CmbCompare1.ListIndex
End With
End Sub

'-----------------------------------------------------------------------------------------------
'コンボボックス [比較方法(条件2)] - 更新後処理イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub CmbCompare2_AfterUpdate()

'比較方法(条件2)の設定を更新
With Me.AutoFilterSetting
.Item(.CurrentFilterControl.Name).FilterCompare2 = Me.CmbCompare2.ListIndex
End With
End Sub

'-----------------------------------------------------------------------------------------------
'コマンドボタン [実行] - クリック時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub CmdExecute_Click()

'オブジェクト変数
Dim clsElement As dbsProject1.ClsAutoFilterControlSetting

'その他の変数
Dim strFilter As String
Dim strText As String

'コンボボックスの選択状況の検査 - 不正な選択状況の場合は処理中止
If Not (IsNull(Me.CmbValues2.Value)) And IsNull(Me.CmbValues1.Value) _
Or Not (IsNull(Me.CmbValues1.Value)) And Me.CmbCompare1.ListIndex < 1 _
Or Not (IsNull(Me.CmbValues2.Value)) And Me.CmbCompare2.ListIndex < 1 Then
VBA.MsgBox _
Prompt:="入力ラインにエラーがあります。" & VBA.vbNewLine _
, Buttons:=VBA.vbCritical Or VBA.vbOKOnly
Me.CmbCompare1.SetFocus
Exit Sub
End If

'フィルタ文字列の生成
For Each clsElement In Me.AutoFilterSetting.Items

'フォーカスを取得しているコントロールの場合
If clsElement.FilterControlName = Me.AutoFilterSetting.CurrentFilterControl.Name Then
Let strText = Me.GetFilter(FilterControlName:=clsElement.FilterControlName)
If Not (Len(strText) = 0) Then
Let strFilter = strFilter & " AND " & strText
End If

'それ以外でフィルタ文字列が設定されているコントロールの場合
ElseIf Not (Len(clsElement.Filter) = 0) Then
Let strFilter = strFilter & " AND " & clsElement.Filter
End If
Next
Let strFilter = Mid(strFilter, Len(" AND ") + 1)

'結果表示用フォームにフィルタ適用
Let Me.AutoFilterSetting.DisplayForm.Filter = strFilter
Let Me.AutoFilterSetting.DisplayForm.FilterOn = True

'フォーカスを取得しているコントロールのフィルタ文字列を更新
With Me.AutoFilterSetting
.Item(.CurrentFilterControl.Name).Filter = strFilter
End With

'フォームを閉じる
Application.DoCmd.Close ObjectType:=acForm, ObjectName:=Me.Name, Save:=acSaveNo
End Sub

'-----------------------------------------------------------------------------------------------
'コマンドボタン [取消] - クリック時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub CmdCancel_Click()

'フォームを閉じる
Application.DoCmd.Close ObjectType:=acForm, ObjectName:=Me.Name, Save:=acSaveNo
End Sub

'-----------------------------------------------------------------------------------------------
'フィルタ文字列の取得
'-----------------------------------------------------------------------------------------------
Public Function GetFilter(ByVal FilterControlName As String) As String

'オブジェクト変数
Dim clsElement As dbsProject1.ClsAutoFilterControlSetting
Dim strOperator As String
Dim strFilter As String

'初期設定
Set clsElement = Me.AutoFilterSetting.Item(Index:=FilterControlName)

'演算子の設定
Select Case Me.FraFilterOption.Value
Case Me.OptAnd.OptionValue
Let strOperator = Space(1) & Me.OptAnd.Controls(0).Caption & Space(1)
Case Me.OptOr.OptionValue
Let strOperator = Space(1) & Me.OptOr.Controls(0).Caption & Space(1)
End Select

'値(条件1)が指定されていない場合
If IsNull(Me.CmbValues1.Value) Then
Let strFilter = ""

'条件1が指定されている場合
Else

'条件1からフィルタ文字列を生成
Let strFilter _
= Application.BuildCriteria( _
Field:=clsElement.FieldName, FieldType:=clsElement.FieldType _
, Expression:=Me.CmbCompare1.Column(1) & Nz(Me.CmbValues1.Value, ""))

'条件2で比較方法のみ指定されている場合
If IsNull(Me.CmbValues2.Value) And Me.CmbCompare2.ListIndex > 0 Then
Let strFilter = ""

'条件2が指定されている場合
ElseIf Not (IsNull(Me.CmbValues2.Value)) Then
Let strFilter _
= strFilter _
& strOperator _
& Application.BuildCriteria( _
Field:=clsElement.FieldName, FieldType:=clsElement.FieldType _
, Expression:=Me.CmbCompare2.Column(1) & Nz(Me.CmbValues2.Value, ""))
End If
End If

'オブジェクト変数の解放
Set clsElement = Nothing

'戻り値の設定 - フィルタ文字列
Let GetFilter = strFilter
End Function

476 hits

▼

【6670】コンボボックスでの検索方法 チャラ 05/10/29(土) 22:42