当记录计数为1时，由ADODB记录集填充的动态列表框不显示项目

Question

嗨，我的列表框有问题。

我想检查一下（在每张桌子上）在餐厅坐了多少人，还要检查有多少人在等待坐下。为此，我将工作表（“ LunchRoom”）用作数据库，并使用ADODB记录集获取每个表的结果。

我无法理解为什么列表框只有一条记录没有被填充？

Sub UserForm_Initialize()

    Dim ctrl As Control
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim i As Integer, L As Integer, T As Integer, W As Integer, H As Integer
    Dim strsql As String
    Dim ArrTables, arr, arrPax, lbx As ListBox

    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    Set rs = New ADODB.Recordset
    Set LBs = New Collection

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"

    strsql = "Select IdClients, Paxname, PaxSurname from [LunchRoom$] where Table is null"
    rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdUnspecified

    If rs.EOF Then lbPaxNoTable.Caption = "Noboby can be seat": GoTo PaxOnTable

    rs.MoveFirst
    arr = rs.GetRows

    With Me.LbxPaxNotSeating
        .Clear
        .ColumnCount = 3
        .ColumnWidths = "0;30;30"
        .List = Application.Transpose(arr)
        .ListIndex = 0
    End With

    lbPaxNoTable.Caption = rs.RecordCount & " people wait to sit down"

    PaxOnTable:
    Set rs = Nothing

    strsql = "Select distinct Table FROM [Tables$]"
    rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdUnspecified
    ReDim ArrTables(0 To rs.RecordCount)

    i = 0
    Do Until rs.EOF
        ArrTables(i) = rs![Table]
        rs.MoveNext
        i = i + 1
    Loop
    Set rs = Nothing

    L = 24
    T = 150
    W = 165
    H = 94

    For i = 0 To UBound(ArrTables) - 1
        If i = 3 Then T = 252: L = 24
        strsql = "Select IdClients, Paxname, PaxSurname from [LunchRoom$] where Table = '" & ArrTables(i) & "'"
        rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdUnspecified
        If rs.EOF Then arrPax = Null Else arrPax = rs.GetRows
        Call Add_Dynamic_lbx(ArrTables(i), "Forms.ListBox.1", arrPax, L, T, H, W)
        Me.Controls("lb" & ArrTables(i)).Caption = rs.RecordCount & " people are seated on " & ArrTables(i)
        L = L + 3 + W
        Set rs = Nothing
    Next i

    Dim lb As MSForms.ListBox
    Dim LMB As ListBoxDragAndDropManager
    Set LBs = New Collection

    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ListBox" Then
            Set LMB = New ListBoxDragAndDropManager
            Set LMB.ThisListBox = ctrl
            LBs.Add LMB
        End If
    Next

    fastexit:
    Set rs = Nothing
    Set cn = Nothing

End Sub

Sub Add_Dynamic_lbx(ByVal nome As String, ctr As String, val, L As Integer, T As Integer, H As Integer, W As Integer)

    Dim lbl As Control, code As String, NextLine As Long
    Set lbl = FrmPlan.Controls.Add(ctr)
    With lbl
        .name = nome
        .Clear
        .ColumnCount = 3
        If Not IsNull(val) Then
            .List = Application.Transpose(val):
            .ListIndex = -1
        End If
        .Width = W
        .ColumnWidths = "0;30;150"               '1th=0 to hide the IdRst
        .Height = H
        .Left = L
        .Top = T
        .ControlTipText = nome
    End With

End Sub

<< img src =“ https://image.soinside.com/eyJ1cmwiOiAiaHR0cHM6Ly9pLnN0YWNrLmltZ3VyLmNvbS9pWHVMVy5wbmcifQ==” alt =“在此处输入图像描述”>

Answer 1

[当您Transpose使用GetRows获得的二维数组时，如果“行”维只有一个插槽，则您将返回一维数组，而不是您期望的翻转二维数组。