フィルター( CombBox )
コンボボックスを使い レコード抽出 を行います。　　引数：コントロール移動の有無・フィールド名
  1. Option Base 1 ：配列の添字の最小値を 1 に設定
  2. コンボボックスの全てのデータ型で抽出できます。
    数値型、日付型はプロパティで書式を設定しないとエラーになる場合があります。
    3. acc05 acc06
  3. 使われているプロシージャ
    ｜抽出条件式の作成 ｜文字列の種類判断 ｜コントロールの値取得｜
レコード 抽出▲ TOP
Option Compare Database
Option Explicit
Option Base 1

Sub SFilterALLTypeChange(myJgo As Integer, myFlFdName As String)

''フィルター すべてのデータ型 ( CombBox )  1:コントロール移動する    2003/5/2
'    SFilterALLTypeChange myJgo,myFlFdName

    Dim myFlvalue As Variant
    Dim myJyo As Integer
    Dim myZJ As String

    myFlvalue = Screen.ActiveControl.OldValue

    myJyo = 1           '1: = 2: >=  3: <=
''Filter 抽出条件式                 '条件 : Condition
    myZJ = FSetFilterConditionCom(myJyo, myFlFdName, myFlvalue)

''フィルタ
    Screen.ActiveForm.Filter = myZJ
    Screen.ActiveForm.FilterOn = True

On Error Resume Next
    If myJgo = 1 Then
        DoCmd.GoToControl myFlFdName
    End If

End Sub
抽出条件式 作成▲ TOP
Function FSetFilterConditionCom(myjs As Integer, myFdN As Variant, myfval As Variant)

''Filter 抽出条件式      1: = 2: >=  3: <=     2003/6/19 '条件 : Condition
'    aba=FSetFilterConditionCom(2, myFdN, myFval)

    Dim myZCheckStr As Integer, myTypeMsg As Integer
    Dim myZEnzansi As String, myZStr As String
    Dim myZemsg1 As String, myZemsg2 As String, myZemsg3 As String

    myTypeMsg = 9
    If myTypeMsg = 1 Then
        myZemsg1 = "Type : " & TypeName(myfval)
        myZemsg2 = "Num : " & IsNumeric(myfval)
        myZemsg3 = "Date : " & IsDate(myfval)

        myZemsg1 = "[ " & myfval & " ]" & vbNewLine & vbNewLine & myZemsg1
        myZemsg2 = vbNewLine & myZemsg2 & vbNewLine
        myZemsg3 = myZemsg1 & myZemsg2 & myZemsg3
        MsgBox myZemsg3, , "Type Check"
    End If

    Select Case myjs
        Case 1
            myZEnzansi = myFdN & " = "
        Case 2
            myZEnzansi = myFdN & " >= "
        Case 3
            myZEnzansi = myFdN & " <= "
        Case 4
            myZEnzansi = myFdN & " <> "
        Case 5
            FSetFilterConditionCom = "Not IsNull(" & myFdN & ")"
            Exit Function
        Case Else
            myZEnzansi = myFdN & " = "
    End Select

''文字列の種類判断     1:半角文字 2:全角文字 3:混在　　　2003/5/1
    myZCheckStr = FCheckUnicode(myfval)
    If myZCheckStr <> 1 Then
        FSetFilterConditionCom = myFdN & " Like '*" & myfval & "*'"
        Exit Function
    End If

    myZStr = TypeName(myfval)
''検索値 データ型・検索式
    Select Case myZStr
        Case "Date"
            FSetFilterConditionCom = myZEnzansi & "#" & myfval & "#"
        Case "Integer", "Double"
            FSetFilterConditionCom = myZEnzansi & myfval
        Case "String"
            FSetFilterConditionCom = myZEnzansi & "'" & myfval & "'"
        Case Else
            FSetFilterConditionCom = myZEnzansi & myfval
    End Select

End Function
文字列の種類判断▲ TOP
Function FCheckUnicode(myCheckStr)

''文字列の種類判断     1:半角文字 2:全角文字 3:混在　　　2003/5/1
'    assa=FCheckUnicode(myCheckStr)

    Dim myStrANSI As String
    Dim myLen As Integer, myLenB As Integer
    
    If myCheckStr = "" Then
        Exit Function
    End If

    myStrANSI = StrConv(myCheckStr, vbFromUnicode)
    myLen = Len(myCheckStr)
    myLenB = LenB(myStrANSI)
    
    If myLen * 2 = myLenB Then
        FCheckUnicode = 2
'        MsgBox "全角文字だけです"
    ElseIf myLen = myLenB Then
        FCheckUnicode = 1
'        MsgBox "半角文字だけです"
    Else
        FCheckUnicode = 3
'        MsgBox "全角と半角が混じっています"
    End If

End Function
コントロールの値取得▲ TOP
Function FGetCtrlValue01(myCtrName1 As Variant)

''値取得 コントロール              2003/5/2
'    myCheck = FGetCtrlValue01(myCtrName1)

    Dim myCtrl As Control
    Dim myZName As Variant
    
On Error Resume Next
    myZName = Replace(myCtrName1, "[", " ")
    myZName = Replace(myZName, "]", " ")
    myZName = Trim(myZName)
    
    For Each myCtrl In Screen.ActiveForm.Controls
        On Error Resume Next
        If myCtrl.name = myZName Then
            FGetCtrlValue01 = myCtrl.OldValue
            Exit For
        End If
    Next
    
End Function
top