1

フォーム上で選択できる 3 つの異なるカテゴリを含むリスト ボックスがあります。リストボックスで複数の項目を選択できるvbaコードが機能していますが、これは問題ありません。しかし、私が選択しているアイテムは、必要な結果を得るのに苦労しています。

例として; リスト ボックス内の 3 つのカテゴリは、実際のカテゴリ名を持つクエリには含まれていません。私が持っている 1 つのカテゴリは「ピッキング」と呼ばれます。「ピッキング」を選択し、ボタンがクリックされたときに、カテゴリを表す「0801」に等しいクエリ フィールド「アイテム番号」内のすべてのアイテムを取得します。ピッキング"。

ボタンの背後にあるコードは、単純な「クリック時」イベント プロシージャであることに注意してください。

**私が問題を抱えているリストボックスは（StrAccounts）と呼ばれています

**tbUpload でフィルター処理しようとしているクエリの Acct と同じものを選ぶ

**リスト ボックスの「ピッキング」カテゴリで、Acct = '0801' のクエリで Acct をフィルター処理する必要があります。

**Placed_Orders は、私の ListBox 内の 2 番目のカテゴリ名であり、"tbUpload"、Acct の上のクエリの同じフィールドですが、この Placed_Orders が ('1108', '1114', '1117', '1113'、'1110')

**クエリ tbUpload の Acct のうち、既に上で言及した次の番号を含まないものは、リスト ボックスの 3 番目のカテゴリであり、"Not_Placed" です。

**したがって、リスト ボックス内の Not_Placed がクリックされ、検索ボタンが選択されるたびに、クエリ内の Accts をプルする必要があります。Accts <> '0801','1108','1114','1117','1113',' 1110'

Private Sub cmdSearch_Click()
Dim Varitem As Variant
Dim StrDEPT_OBS As String
Dim StrStatus As String
Dim StrACCT As String
Dim strSQL As String
Dim StrAccounts As String

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me!List_Dept_OBS.ItemsSelected
StrDEPT_OBS = StrDEPT_OBS & ",'" & Me!List_Dept_OBS.ItemData(Varitem) & "'"
Next

'get selections from Status multiselect listbox
For Each Varitem In Me!List_Status.ItemsSelected
StrStatus = StrStatus & ",'" & Me!List_Status.ItemData(Varitem) & "'"
Next

'get selections from Accts multiselect listbox
 For Each Varitem In Me!List_ACCTs.ItemsSelected
 StrStatus = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
 Next



 If Len(StrDEPT_OBS) > 0 Then
 StrDEPT_OBS = Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1)
 Else: MsgBox "You must enter an OBS"

 Exit Sub
 End If

 If Len(StrStatus) > 0 Then
 StrStatus = Right(StrStatus, Len(StrStatus) - 1)
 End If

 If Len(StrAccounts) > 0 Then
 StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
  End If



  strSQL = " SELECT * FROM tbUpload WHERE "
  strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStatus & ") "
   End If



    If Len(StrAccounts) = 0 And StrAccounts = "Picking" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If Len(StrAccounts) = 0 And StrAccounts = "Placed_Orders" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
        strSQL = strSQL & "tbUpload.ACCT <> (" & [0801] & [1108] & [1114] & [1117] & [1113] & [1110] & ") " "Not_Placed"
End If




DoCmd.SetWarnings False
''DoCmd.OpenQuery ("UPLOAD")
 Me![tbUpload subform].Form.RecordSource = strSQL

 End Sub









If Len(StrAccounts) > 0 Then
'' StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
StrAccounts = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
End If


strSQL = " SELECT * FROM tbUpload WHERE "
strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStat   us & ") "
   End If



    If StrAccounts = "Lugging" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If StrAccounts = "Structure" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
    End If
4

1 に答える 1