自动化列表框选择(Automate Listbox Selection)

自动化列表框选择(Automate Listbox Selection)

我有一个我希望能够自动化的列表框，这样当我输入一个项目的总数量时，它将多次选择行直到达到该总数。 在MS Access的范围内我想做什么？ 我一直在搜索和搜索，似乎找不到任何东西来告诉我从哪里开始。

' Spin through the Array adding up rows to fulfill the needed quantity, following will search and possibly use part of a BIN If ListArray(i, 1) <> "" And ListArray(i, 1) <= iQty Then ' skip empty array; check if less than qty While index <= Me.lstShipping.ListCount lstShipping(ListArray(i, 0)) = True ' select this row in ListBox iSelected = iSelected + ListArray(i, 1) ' track total qty selected If iSelected = iQty Then ' if enough is selected, end Exit While End If index += 1 End While

I have a listbox that I want to be able to automate so that when I enter the total quantity of an item it will multi-select the rows until it reaches that total. Is what I want to do possible within the confines of MS Access? I have been searching and searching and can't seem to find anything to show me where to start.

' Spin through the Array adding up rows to fulfill the needed quantity, following will search and possibly use part of a BIN If ListArray(i, 1) <> "" And ListArray(i, 1) <= iQty Then ' skip empty array; check if less than qty While index <= Me.lstShipping.ListCount lstShipping(ListArray(i, 0)) = True ' select this row in ListBox iSelected = iSelected + ListArray(i, 1) ' track total qty selected If iSelected = iQty Then ' if enough is selected, end Exit While End If index += 1 End While

最满意答案

更新以添加缺少的功能...以下代码将旋转您的列表框，寻找匹配的'Lot＃'s并选择将提供所需数量的行。 列表框数量被放入一个数组中，然后进行排序，这样它将需要最小的数量来释放大多数垃圾箱。 我懒得让代码取消选择多个先前选择的行来达到正确的数量，但msgbox会提醒你。 只需调用传递数量和Lot＃的函数。

Option Compare Database Option Explicit Dim myarray() As Variant Private Sub cmdSearchBins_Click() Mark_ListBox_Rows Me.txtQty, "Lot-A" End Sub Function Mark_ListBox_Rows(Qty As Integer, LotNbr As String) Dim i As Integer Dim i2 As Integer Dim iStart As Integer Dim iQty As Integer Dim iReserved As Integer Dim iAddRow As Integer Dim iColUsed As Integer Dim iMaxQtyAvail As Integer '(1)Either pass the qty (and Lot #) to this routine, or change code to get Qty from another control and set iQty '(2) Modify code for correct column (I am using col 4 (3 if relative to zero)) '(3) Most times automatic selection will be made. If unable to find simple (one row) solution, let the user pick. iColUsed = 3 ' (relative to zero) iMaxQtyAvail = 0 If IsNull(Qty) Or Qty = 0 Then MsgBox "You must specify the Quantity!", vbOKOnly, "No Quantity Entered" Exit Function End If If Me.List2.ColumnHeads = True Then ' Check if listbox has headings iStart = 1 ' Adjust starting row + 1 Else iStart = 0 End If ReDim myarray(Me.List2.ListCount, 2) 'Resize Array as needed 'Populate Array with ListBox Row & Qty i2 = 0 For i = 0 To Me.List2.ListCount ' Spin through listbox If Me.List2.Column(2, iStart + i) = LotNbr Then ' Make sure Lot # matches If Me.List2.Column(iColUsed, iStart + i) <> 0 Then ' Make sure not = 0 (doubt it is in your list, but...) myarray(i2, 0) = iStart + i2 ' Save Row number, then Qty myarray(i2, 1) = Int(Me.List2.Column(iColUsed, iStart + i)) iMaxQtyAvail = iMaxQtyAvail + Int(Me.List2.Column(iColUsed, iStart + i)) 'Debug.Print "List Row: " & i2 & vbTab & "Qty: " & myarray(i2, 1) i2 = i2 + 1 End If End If Next i If iMaxQtyAvail < Qty Then MsgBox "All rows combined only have a quantity of: " & iMaxQtyAvail & vbCrLf & "You asked for quantity of : " & Qty, vbOKOnly, "Insufficient Quantity Available" GoTo End_Here End If myarray = BubbleSrt(myarray, True) ' Sort my Array by Quantity ' For i = 0 To UBound(myarray) ' List what the Array looks like after sorting. ' Debug.Print "Array: " & i & vbTab & myarray(i, 0) & " - " & myarray(i, 1) ' Next i iQty = Qty iReserved = 0 For i = 0 To Me.List2.ListCount 'Deselect ALL rows in Listbox - in case someone already started.... List2.Selected(i) = False Next i For i = 0 To UBound(myarray) ' Spin through the Array adding up rows to fulfill the desired quantity 'The following will search and possibly use part of a bin. If myarray(i, 1) <> "" And myarray(i, 1) <= iQty Then ' Skip empty Array; check if <= Qty If iReserved + myarray(i, 1) <= iQty Then 'Debug.Print "Row: " & myarray(iStart + i, 0) & vbTab & "Qty: " & myarray(iStart + i, 1) List2.Selected(myarray(i, 0)) = True ' Select this row in Listbox iReserved = iReserved + myarray(i, 1) ' Keep track of total reserved so far If iReserved = iQty Then ' If just the right number, get outta here! 'Me.txtReserved = iReserved GoTo End_Here End If Else ' Need to Adjust ' Not so simple. Need to see if can deselect a prior selected row and keep this row to arrive at total. 'Debug.Print "Need to Adjust; Qty Required / Current Reserved + ListItem = " & Qty & " / " & iReserved + myarray(iStart + i, 1) iAddRow = i ' Save the row with the qty that would put us over the limit. For i2 = iStart + i To 1 Step -1 ' Walk backwards so we deselect largest qty. If ((iReserved + myarray(iAddRow, 1)) - myarray(i2, 1)) = iQty Then ' Found the right combination. Deselect this row, and select the row from earlier 'Debug.Print "Swap Rows" List2.Selected(myarray(i2, 0)) = False ' Unselect this row in Listbox List2.Selected(myarray(iAddRow, 0)) = True ' Select this row in Listbox iReserved = iReserved + myarray(iAddRow, 1) - myarray(i2, 1) ' Count Total Reserved 'Me.txtReserved = iReserved GoTo End_Here End If Next i2 ' Yikes! I don't frrl like coding to handle deselecting some combination of 2 or more!!! MsgBox "Qty Needed = " & Qty & vbCrLf & "Qty selected = " & iReserved & vbCrLf & vbCrLf & "Please manually select/deselect to obtain desired quantity", vbOKOnly, "Manually Select Quantity" GoTo End_Here End If End If Next i If iQty > iReserved Then MsgBox "Unable to find sufficient part quantity!", vbOKOnly, "Not Enough Parts" 'Deselect ALL For i = 0 To Me.List2.ListCount List2.Selected(i) = False Next i End If End_Here: 'Me.txtQty = Me.txtQty + 1 End Function Public Function BubbleSrt(ArrayIn As Variant, Ascending As Boolean) Dim SrtTemp As Variant Dim i As Long Dim j As Long Dim SrtTemp0 As Variant Dim SrtTemp1 As Variant If Ascending = True Then For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i, 1) > ArrayIn(j, 1) Then SrtTemp0 = ArrayIn(j, 0) SrtTemp1 = ArrayIn(j, 1) ArrayIn(j, 0) = ArrayIn(i, 0) ArrayIn(j, 1) = ArrayIn(i, 1) ArrayIn(i, 0) = SrtTemp0 ArrayIn(i, 1) = SrtTemp1 End If Next j Next i Else For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) < ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i End If BubbleSrt = ArrayIn End Function

Updated to add missing Function... The following code will spin through your listbox looking for matching 'Lot #'s' and selecting rows that will provide the desired quantity. The listbox qty's are placed into an array, then sorted so it will take smallest qty's first to free up most bins. I was too lazy to have code deselect more than one previously selected row to arrive at correct qty, but a msgbox will alert you to that. Just call the function passing the quantity and Lot# .

Option Compare Database Option Explicit Dim myarray() As Variant Private Sub cmdSearchBins_Click() Mark_ListBox_Rows Me.txtQty, "Lot-A" End Sub Function Mark_ListBox_Rows(Qty As Integer, LotNbr As String) Dim i As Integer Dim i2 As Integer Dim iStart As Integer Dim iQty As Integer Dim iReserved As Integer Dim iAddRow As Integer Dim iColUsed As Integer Dim iMaxQtyAvail As Integer '(1)Either pass the qty (and Lot #) to this routine, or change code to get Qty from another control and set iQty '(2) Modify code for correct column (I am using col 4 (3 if relative to zero)) '(3) Most times automatic selection will be made. If unable to find simple (one row) solution, let the user pick. iColUsed = 3 ' (relative to zero) iMaxQtyAvail = 0 If IsNull(Qty) Or Qty = 0 Then MsgBox "You must specify the Quantity!", vbOKOnly, "No Quantity Entered" Exit Function End If If Me.List2.ColumnHeads = True Then ' Check if listbox has headings iStart = 1 ' Adjust starting row + 1 Else iStart = 0 End If ReDim myarray(Me.List2.ListCount, 2) 'Resize Array as needed 'Populate Array with ListBox Row & Qty i2 = 0 For i = 0 To Me.List2.ListCount ' Spin through listbox If Me.List2.Column(2, iStart + i) = LotNbr Then ' Make sure Lot # matches If Me.List2.Column(iColUsed, iStart + i) <> 0 Then ' Make sure not = 0 (doubt it is in your list, but...) myarray(i2, 0) = iStart + i2 ' Save Row number, then Qty myarray(i2, 1) = Int(Me.List2.Column(iColUsed, iStart + i)) iMaxQtyAvail = iMaxQtyAvail + Int(Me.List2.Column(iColUsed, iStart + i)) 'Debug.Print "List Row: " & i2 & vbTab & "Qty: " & myarray(i2, 1) i2 = i2 + 1 End If End If Next i If iMaxQtyAvail < Qty Then MsgBox "All rows combined only have a quantity of: " & iMaxQtyAvail & vbCrLf & "You asked for quantity of : " & Qty, vbOKOnly, "Insufficient Quantity Available" GoTo End_Here End If myarray = BubbleSrt(myarray, True) ' Sort my Array by Quantity ' For i = 0 To UBound(myarray) ' List what the Array looks like after sorting. ' Debug.Print "Array: " & i & vbTab & myarray(i, 0) & " - " & myarray(i, 1) ' Next i iQty = Qty iReserved = 0 For i = 0 To Me.List2.ListCount 'Deselect ALL rows in Listbox - in case someone already started.... List2.Selected(i) = False Next i For i = 0 To UBound(myarray) ' Spin through the Array adding up rows to fulfill the desired quantity 'The following will search and possibly use part of a bin. If myarray(i, 1) <> "" And myarray(i, 1) <= iQty Then ' Skip empty Array; check if <= Qty If iReserved + myarray(i, 1) <= iQty Then 'Debug.Print "Row: " & myarray(iStart + i, 0) & vbTab & "Qty: " & myarray(iStart + i, 1) List2.Selected(myarray(i, 0)) = True ' Select this row in Listbox iReserved = iReserved + myarray(i, 1) ' Keep track of total reserved so far If iReserved = iQty Then ' If just the right number, get outta here! 'Me.txtReserved = iReserved GoTo End_Here End If Else ' Need to Adjust ' Not so simple. Need to see if can deselect a prior selected row and keep this row to arrive at total. 'Debug.Print "Need to Adjust; Qty Required / Current Reserved + ListItem = " & Qty & " / " & iReserved + myarray(iStart + i, 1) iAddRow = i ' Save the row with the qty that would put us over the limit. For i2 = iStart + i To 1 Step -1 ' Walk backwards so we deselect largest qty. If ((iReserved + myarray(iAddRow, 1)) - myarray(i2, 1)) = iQty Then ' Found the right combination. Deselect this row, and select the row from earlier 'Debug.Print "Swap Rows" List2.Selected(myarray(i2, 0)) = False ' Unselect this row in Listbox List2.Selected(myarray(iAddRow, 0)) = True ' Select this row in Listbox iReserved = iReserved + myarray(iAddRow, 1) - myarray(i2, 1) ' Count Total Reserved 'Me.txtReserved = iReserved GoTo End_Here End If Next i2 ' Yikes! I don't frrl like coding to handle deselecting some combination of 2 or more!!! MsgBox "Qty Needed = " & Qty & vbCrLf & "Qty selected = " & iReserved & vbCrLf & vbCrLf & "Please manually select/deselect to obtain desired quantity", vbOKOnly, "Manually Select Quantity" GoTo End_Here End If End If Next i If iQty > iReserved Then MsgBox "Unable to find sufficient part quantity!", vbOKOnly, "Not Enough Parts" 'Deselect ALL For i = 0 To Me.List2.ListCount List2.Selected(i) = False Next i End If End_Here: 'Me.txtQty = Me.txtQty + 1 End Function Public Function BubbleSrt(ArrayIn As Variant, Ascending As Boolean) Dim SrtTemp As Variant Dim i As Long Dim j As Long Dim SrtTemp0 As Variant Dim SrtTemp1 As Variant If Ascending = True Then For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i, 1) > ArrayIn(j, 1) Then SrtTemp0 = ArrayIn(j, 0) SrtTemp1 = ArrayIn(j, 1) ArrayIn(j, 0) = ArrayIn(i, 0) ArrayIn(j, 1) = ArrayIn(i, 1) ArrayIn(i, 0) = SrtTemp0 ArrayIn(i, 1) = SrtTemp1 End If Next j Next i Else For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) < ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i End If BubbleSrt = ArrayIn End Function