Access VBA質問箱 IV

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

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


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

1538 / 2272 ﾂﾘｰ

←次へ　｜　前へ→

▼

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

【6672】コンボボックスでの検索方法（２） チャラ 05/10/29(土) 23:05

【6674】コンボボックスでの検索方法（３） チャラ 05/10/29(土) 23:38

【6675】コンボボックスでの検索方法（４） チャラ 05/10/29(土) 23:41

【6676】コンボボックスでの検索方法（５） チャラ 05/10/29(土) 23:47

【6677】コンボボックスでの検索方法（６） チャラ 05/10/29(土) 23:49

【6678】コンボボックスでの検索方法（７） チャラ 05/10/30(日) 0:01

【6679】Re:コンボボックスでの検索方法 まさ7251 05/10/30(日) 1:00


	【6670】コンボボックスでの検索方法

チャラ - 05/10/29(土) 22:42 -


	引用なし

	パスワード

エクセルのフィルタ機能のようなコンボボックスを作りたいのですが、どうしたらよいか
分かりません。ご指導お願いします。

(1) テーブル
---------------------------------------------------------------------------テーブル[T1]
---------------------------------------------------------------------------
F1 F2 F3
---------------------------------------------------------------------------
1 AAA 2005/01/01
1 AAA 2005/01/02
1 AAA 2005/01/01
1 AAA 2005/01/02
2 AAA 2005/01/01
2 AAA 2005/01/02
2 BBB 2005/01/01
2 BBB 2005/01/02
3 AAA 2005/01/03
3 AAA 2005/01/03
3 BBB 2005/01/03
3 BBB 2005/01/03

F1: 長整数型
F2: テキスト型
F3: 日付時刻型

(2) フォーム（使用するセクションおよびコントロールと初期状態から変更するプロパティ）
---------------------------------------------------------------------------
フォーム[FrmSub]
---------------------------------------------------------------------------
RecordSource/レコードソース: T1
---------------------------------------------------------------------------
詳細
---------------------------------------------------------------------------
テキストボックス[TxtF1] ControlSource/コントロールソース: F1
テキストボックス[TxtF2] ControlSource/コントロールソース: F2
テキストボックス[TxtF3] ControlSource/コントロールソース: F3

---------------------------------------------------------------------------
フォーム[FrmMain]
---------------------------------------------------------------------------
フォームヘッダ
---------------------------------------------------------------------------
コンボボックス[CmbF1] Tag/タグ: F1
コンボボックス[CmbF2] Tag/タグ: F2
コンボボックス[CmbF3] Tag/タグ: F3

---------------------------------------------------------------------------
詳細
---------------------------------------------------------------------------
サブフォームコントロール[SfmFrmSub] SourceObject/ソースオブジェクト: FrmSub
---------------------------------------------------------------------------

フォーム[FrmAutoFilterOption] - [オートフィルタオプション]ダイアログ
---------------------------------------------------------------------------
オプショングループ[FraFilterOption]

コンボボックス[CmbValues1]
コンボボックス[CmbValues2]

コンボボックス[CmbCompare1]
コンボボックス[CmbCompare2]

オプションボタン[OptAnd] 付属ラベル Caption/標題：AND
オプションボタン[OptOr] 付属ラベル Caption/標題：OR

コマンドボタン[CmdExecute]
コマンドボタン[CmdCancel]

現在、上記のようなフォーム・テーブルがあります。


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

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


	引用なし

	パスワード

＜つづき＞

次に教えてもらったコードを書き込みました。

(3) クラスモジュール
---------------------------------------------------------------------------クラスモジュール[ClsAutoFilterControlSetting]
---------------------------------------------------------------------------
Option Compare Database
Option Explicit

'--------------------------------------------------------------------------
'プロパティ値保存用変数(1)
'--------------------------------------------------------------------------
Private mFilterControlName As String 'コントロールの名前
Private mFieldName As String '対応するフィールドの名前
Private mFieldType As Long '対応するフィールドのデータ型
Private mFilter As String '対応するフィールドに対する抽出条件

'--------------------------------------------------------------------------
'プロパティ値保存用変数(2)
'--------------------------------------------------------------------------
Private mFilterValues1 As Variant '値(条件1)
Private mFilterValues2 As Variant '値(条件2)
Private mFilterCompare1 As Long '比較方法(条件1)
Private mFilterCompare2 As Long '比較方法(条件2)
Private mFilterOperator As Long '演算子

'--------------------------------------------------------------------------
'プロパティの値を取得 - コントロールの名前
'--------------------------------------------------------------------------
Public Property Get FilterControlName() As String
　　　Let FilterControlName = mFilterControlName
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - コントロールの名前
'--------------------------------------------------------------------------
Public Property Let FilterControlName(ByVal pFilterControlName As String)
　　　Let mFilterControlName = pFilterControlName
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 対応するフィールドの名前
'--------------------------------------------------------------------------
Public Property Get FieldName() As String
　　　Let FieldName = mFieldName
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 対応するフィールドの名前
'--------------------------------------------------------------------------
Public Property Let FieldName(ByVal pFieldName As String)
　　　Let mFieldName = pFieldName
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 対応するフィールドのデータ型
'--------------------------------------------------------------------------
Public Property Get FieldType() As Long
　　　Let FieldType = mFieldType
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 対応するフィールドのデータ型
'--------------------------------------------------------------------------
Public Property Let FieldType(ByVal pFieldType As Long)
　　　Let mFieldType = pFieldType
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 対応するフィールドに対する抽出条件
'--------------------------------------------------------------------------
Public Property Get Filter() As String
　　　Let Filter = mFilter
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 対応するフィールドに対する抽出条件
'--------------------------------------------------------------------------
Public Property Let Filter(ByVal pFilter As String)
　　　Let mFilter = pFilter
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 値(条件1)
'--------------------------------------------------------------------------
Public Property Get FilterValues1() As Variant
　　　Let FilterValues1 = mFilterValues1
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 値(条件1)
'--------------------------------------------------------------------------
Public Property Let FilterValues1(ByVal pFilterValues1 As Variant)
　　　Let mFilterValues1 = pFilterValues1
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 値(条件2)
'--------------------------------------------------------------------------
Public Property Get FilterValues2() As Variant
　　　Let FilterValues2 = mFilterValues2
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 値(条件2)
'--------------------------------------------------------------------------
Public Property Let FilterValues2(ByVal pFilterValues2 As Variant)
　　　Let mFilterValues2 = pFilterValues2
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 比較方法(条件1)
'--------------------------------------------------------------------------
Public Property Get FilterCompare1() As Long
　　　Let FilterCompare1 = mFilterCompare1
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 比較方法(条件1)
'--------------------------------------------------------------------------
Public Property Let FilterCompare1(ByVal pFilterCompare1 As Long)
　　　Let mFilterCompare1 = pFilterCompare1
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 比較方法(条件2)
'--------------------------------------------------------------------------
Public Property Get FilterCompare2() As Long
　　　Let FilterCompare2 = mFilterCompare2
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 比較方法(条件2)
'--------------------------------------------------------------------------
Public Property Let FilterCompare2(ByVal pFilterCompare2 As Long)
　　　Let mFilterCompare2 = pFilterCompare2
End Property

'--------------------------------------------------------------------------
'プロパティの値を取得 - 演算子
'--------------------------------------------------------------------------
Public Property Get FilterOperator() As Long
　　　Let FilterOperator = mFilterOperator
End Property

'--------------------------------------------------------------------------
'プロパティに値を設定 - 演算子
'--------------------------------------------------------------------------
Public Property Let FilterOperator(ByVal pFilterOperator As Long)
　　　Let mFilterOperator = pFilterOperator
End Property


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

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


	引用なし

	パスワード

＜つづき２＞
---------------------------------------------------------------------------
クラスモジュール[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


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

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


	引用なし

	パスワード

'--------------------------------------------------------------------------
'値集合ソースの取得
'-------------------------------------------------------------------------
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


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

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


	引用なし

	パスワード

＜つづき３＞

(4) フォームのクラスモジュール
------------------------------------------------------------------------------------------------
フォーム[FrmMain]
------------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit

'-----------------------------------------------------------------------------------------------
'プロパティ値保存用オブジェクト変数
'-----------------------------------------------------------------------------------------------
Private mAutoFilterSetting As dbsProject1.ClsAutoFilterSetting

'-----------------------------------------------------------------------------------------------
'プロパティの値を取得 - オートフィルタ設定
'-----------------------------------------------------------------------------------------------
Public Property Get AutoFilterSetting() As dbsProject1.ClsAutoFilterSetting
Set AutoFilterSetting = mAutoFilterSetting
End Property

'-----------------------------------------------------------------------------------------------
'プロパティに値を設定 - オートフィルタ設定
'-----------------------------------------------------------------------------------------------
Public Property Set AutoFilterSetting(ByVal pAutoFilterSetting As dbsProject1.ClsAutoFilterSetting)
Set mAutoFilterSetting = pAutoFilterSetting
End Property

'-----------------------------------------------------------------------------------------------
'フォーム - 読み込み時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub Form_Load()
Set mAutoFilterSetting = New dbsProject1.ClsAutoFilterSetting
Me.AutoFilterSetting.PropertyInitialize _
MainForm:=Me _
, DisplayForm:=Me.SfmFrmSub.Form _
, rstRecordSource:=Me.SfmFrmSub.Form.RecordsetClone
End Sub

'-----------------------------------------------------------------------------------------------
'フォーム - 閉じる時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub Form_Close()
Set mAutoFilterSetting = Nothing
End Sub

'-----------------------------------------------------------------------------------------------
'条件指定用コントロールのフォーカス取得後
'-----------------------------------------------------------------------------------------------
Private Function EvtFilterControl_OnGotFocus() As Long
Me.AutoFilterSetting.EvtFilterControlGotFocus FilterControl:=Me.ActiveControl
End Function

'-----------------------------------------------------------------------------------------------
'条件指定用コントロールの更新後処理
'-----------------------------------------------------------------------------------------------
Private Function EvtFilterControl_AfterUpdate() As Long
Me.AutoFilterSetting.EvtFilterControlAfterUpdate FilterControl:=Me.ActiveControl
End Function

------------------------------------------------------------------------------------------------
フォーム[FrmAutoFilterOption]
------------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit

'-----------------------------------------------------------------------------------------------
'プロパティ値保存用定数
'-----------------------------------------------------------------------------------------------
Private Const cFilterCompareRowSourceType As String = "Value List"
Private Const cFilterCompareRowSource As String _
= ";;" _
& "と等しい;=;" _
& "と等しくない;<>;"

'-----------------------------------------------------------------------------------------------
'プロパティ値保存用オブジェクト変数
'-----------------------------------------------------------------------------------------------
Private mAutoFilterSetting As dbsProject1.ClsAutoFilterSetting

'-----------------------------------------------------------------------------------------------
'プロパティの値を取得 - オートフィルタ設定
'-----------------------------------------------------------------------------------------------
Public Property Get AutoFilterSetting() As dbsProject1.ClsAutoFilterSetting
Set AutoFilterSetting = mAutoFilterSetting
End Property

'-----------------------------------------------------------------------------------------------
'プロパティに値を設定 - オートフィルタ設定
'-----------------------------------------------------------------------------------------------
Public Property Set AutoFilterSetting(ByVal pAutoFilterSetting As dbsProject1.ClsAutoFilterSetting)
Set mAutoFilterSetting = pAutoFilterSetting
End Property

'-----------------------------------------------------------------------------------------------
'フォーム - 開く時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub Form_Open(Cancel As Integer)

'他のフォームから呼び出されていない場合
If IsNull(Me.OpenArgs) Then
Let Cancel = True
End If
End Sub

'-----------------------------------------------------------------------------------------------
'フォーム - 読み込み時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub Form_Load()

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

'初期設定
Set mAutoFilterSetting = Application.Forms(Me.OpenArgs).AutoFilterSetting
Set clsElement = Me.AutoFilterSetting.Items(Index:=Me.AutoFilterSetting.CurrentFilterControl.Name)

'オプショングループのラベルに対象フィールド名を設定
Let Me.FraFilterOption.Controls(0).Caption = clsElement.FieldName

'演算子の設定
Select Case clsElement.FilterOperator

'設定が保存されている場合
Case Me.OptAnd.OptionValue, Me.OptOr.OptionValue
Let Me.FraFilterOption.Value = clsElement.FilterOperator

'そうでない場合 - ANDに設定
Case Else
Let Me.FraFilterOption.Value = Me.OptAnd.OptionValue
End Select

'値(条件1)指定用コンボボックスの設定
Let Me.CmbValues1.RowSource _
= Me.AutoFilterSetting.GetRowSource( _
FilterControlName:=clsElement.FilterControlName, AddListOption:=False)
If Not (IsNull(clsElement.FilterValues1)) Then
Let Me.CmbValues1.Value = clsElement.FilterValues1
End If

'値(条件2)指定用コンボボックスの値集合ソース(2)
Let Me.CmbValues2.RowSource _
= Me.AutoFilterSetting.GetRowSource( _
FilterControlName:=clsElement.FilterControlName, AddListOption:=False)
If Not (IsNull(clsElement.FilterValues2)) Then
Let Me.CmbValues2.Value = clsElement.FilterValues2
End If

'比較方法指定用コンボボックスの設定(1)
With Me.CmbCompare1
.ColumnCount = 2
.RowSourceType = cFilterCompareRowSourceType
.RowSource = cFilterCompareRowSource
.ColumnWidths = Format(.Width, "0\;") & "0;"
.Value = .ItemData(clsElement.FilterCompare1)
End With

'比較方法指定用コンボボックスの設定(1)
With Me.CmbCompare2
.ColumnCount = 2
.RowSourceType = cFilterCompareRowSourceType
.RowSource = cFilterCompareRowSource
.ColumnWidths = Format(.Width, "0\;") & "0;"
.Value = .ItemData(clsElement.FilterCompare2)
End With

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

'-----------------------------------------------------------------------------------------------
'フォーム - 閉じる時イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub Form_Close()
Set mAutoFilterSetting = Nothing
End Sub

'-----------------------------------------------------------------------------------------------
'オプショングループ [条件] - 更新後処理イベントプロシージャ
'-----------------------------------------------------------------------------------------------
Private Sub FraFilterOption_AfterUpdate()

'演算子の設定を更新
With Me.AutoFilterSetting
.Item(.CurrentFilterControl.Name).FilterOperator = Me.FraFilterOption.Value
End With
End Sub

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

'値(条件1)の設定を更新
With Me.AutoFilterSetting
.Item(.CurrentFilterControl.Name).FilterValues1 = Me.CmbValues1.Value
End With
End Sub


	【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


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

チャラ - 05/10/30(日) 0:01 -


	引用なし

	パスワード

見難くて申し訳ありません。

メインフォームにあるコンボボックスのリストから（オプション）を選択すると
フィルターオプションフォームが開き、○○と等しい、○○と等しくない
を検索する事ができます。

ここに、○○を含む　○○を含まない　を加えたいのですがどのようにしたらよいか
分かりません。

たぶん

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

ここの部分に少し修正が必要みたいなのですが…。


	【6679】Re:コンボボックスでの検索方法

まさ7251 - 05/10/30(日) 1:00 -


	引用なし

	パスワード

こんばんは、まさ7251です。

> メインフォームにあるコンボボックスのリストから（オプション）を選択すると
> フィルターオプションフォームが開き、○○と等しい、○○と等しくない
> を検索する事ができます。

> ここに、○○を含む　○○を含まない　を加えたいのですが
> どのようにしたらよいか分かりません。

> たぶん
> フィルタ文字列の取得
> '----------------------------------------------------------------------
> Public Function GetFilter(ByVal FilterControlName As String) As String
> End Function
> ここの部分に少し修正が必要みたいなのですが…。

修正が必要と思われる部分の見当がついているのでしたら、
まずはご自分で試行錯誤しながら修正してみてはどうでしょうか。
その上で、”どのようにして、どううまく行かなかったのか”を
書き込むべきかと思います。

また、これだけの説明およびコードを書き込まれましても、
これを再現するのにはだいぶ時間がかかります。
回答してもらう人にそこまで要求するのはどうかと思います。
本来なら、問題のある部分だけを抜粋して書き込むのが
筋かと思います。

それが出来ないのでしたら、せめてmdbを圧縮して見てもらうことが
出来るようにする等の配慮があっても良いかと思いますが、
どうでしょうか。

PS.本質問は、以前に他の掲示板にて質問していたものの続きですよね。
　コードもその際に提示してもらったものかと思います。
　なぜ、他の掲示板にて新たに質問するのかよくわかりません。


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

1538 / 2272 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free