vba - 列表框 - 运行时 380 错误无效的属性值

Question

下午

在VB的世界里，我只是一个业余爱好者的新手。

我目前正在 Excel 中创建用户表单并搜索记录，我决定使用列表框选项来允许用户滚动搜索结果。

但是，由于列表框超过十个条目，我遇到了运行时 380 错误无效属性值。

我已经设法使用 rowsource 命令找到了解决方案，但我找不到如何在我的代码中使用它。欢迎任何建议，如果有人能想到更好的方法，我将不胜感激。

`enter code here

Dim MyData     As Range
Dim c          As Range
Dim rFound     As Range
Dim r          As Long
Dim rng        As Range
Const frmMax   As Long = 640
Const frmHt    As Long = 210
Const frmWidth As Long = 280
Dim sFileName  As String
Dim oCtrl      As MSForms.Control

Private Sub Add_Click()
    Set c = Range("a65536").End(xlUp).Offset(1, 0)
    Application.ScreenUpdating = False
    With Me
        c.Value = .TextBox1.Value
        c.Offset(0, 1).Value = .TextBox2.Value
        c.Offset(0, 2).Value = .TextBox3.Value
        c.Offset(0, 3).Value = .TextBox4.Value
        c.Offset(0, 4).Value = .TextBox5.Value
        c.Offset(0, 5).Value = .TextBox6.Value
        c.Offset(0, 6).Value = .TextBox7.Value
        c.Offset(0, 7).Value = .TextBox8.Value
        c.Offset(0, 8).Value = .TextBox9.Value
        c.Offset(0, 9).Value = .TextBox10.Value
        c.Offset(0, 10).Value = .TextBox11.Value

        ClearControls
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub Find_Click()
    Worksheets("Master").Activate
    Dim strFind As String
    Dim FirstAddress As String
    Dim rSearch As Range
    Set rSearch = Range("a1", Range("e65536").End(xlUp))
    Dim f      As Integer

    strFind = Me.TextBox1.Value

    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then
            c.Select
            With Me
                .TextBox2.Value = c.Offset(0, 1).Value
                .TextBox3.Value = c.Offset(0, 2).Value
                .TextBox4.Value = c.Offset(0, 3).Value
                .TextBox5.Value = c.Offset(0, 4).Value
                .TextBox6.Value = c.Offset(0, 5).Value
                .TextBox7.Value = c.Offset(0, 6).Value
                .TextBox8.Value = c.Offset(0, 7).Value
                .TextBox9.Value = c.Offset(0, 8).Value
                .TextBox10.Value = c.Offset(0, 9).Value

                .update.Enabled = True
                .Add.Enabled = False
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")

                    Case vbOK
                        FindAll
                    Case vbCancel

                End Select
                Me.Height = frmMax

            End If
        Else: MsgBox strFind & " not listed"
        End If
    End With
    If Sheet2.AutoFilterMode Then Sheet2.Range("A8").AutoFilter

End Sub

Private Sub TextBox11_Change()

End Sub

Private Sub update_Click()
    Application.ScreenUpdating = False
    If rng Is Nothing Then GoTo skip
    For Each c In rng
        If r = 0 Then c.Select
        r = r - 1
    Next c
skip:
    Set c = ActiveCell
    c.Value = Me.TextBox1.Value
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    c.Offset(0, 4).Value = Me.TextBox5.Value
    c.Offset(0, 5).Value = Me.TextBox6.Value
    c.Offset(0, 6).Value = Me.TextBox7.Value
    c.Offset(0, 7).Value = Me.TextBox8.Value
    c.Offset(0, 8).Value = Me.TextBox9.Value
    c.Offset(0, 9).Value = Me.TextBox10.Value
    c.Offset(0, 10).Value = Me.TextBox11.Value

    With Me
        .update.Enabled = False
        .Add.Enabled = True
        ClearControls
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A8").AutoFilter
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub
Sub FindAll()
    Worksheets("Master").Activate
    Dim strFind As String
    Dim rFilter As Range
    Set rFilter = Sheet2.Range("a1", Range("Z65536").End(xlUp))
    Set rng = Sheet2.Range("a1", Range("a65536").End(xlUp))
    strFind = Me.TextBox1.Value
    With Sheet2
        If Not .AutoFilterMode Then .Range("A2").AutoFilter
        rFilter.AutoFilter Field:=1, Criteria1:=strFind
        Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
        Me.ListBox1.Clear
        For Each c In rng
            With Me.ListBox1
                .AddItem c.Value
                .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
                .List(.ListCount - 1, 5) = c.Offset(0, 5).Value
                .List(.ListCount - 1, 6) = c.Offset(0, 6).Value
                .List(.ListCount - 1, 7) = c.Offset(0, 7).Value
                .List(.ListCount - 1, 8) = c.Offset(0, 8).Value
                .List(.ListCount - 1, 9) = c.Offset(0, 9).Value
                .List(.ListCount - 1, 10) = c.Offset(0, 10).Value

            End With
        Next c
    End With
End Sub

Private Sub ListBox1_Click()

    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 1 Then    'User has selected
        r = Me.ListBox1.ListIndex

        With Me
            .TextBox1.Value = ListBox1.List(r, 0)
            .TextBox2.Value = ListBox1.List(r, 1)
            .TextBox3.Value = ListBox1.List(r, 2)
            .TextBox4.Value = ListBox1.List(r, 3)
            .TextBox5.Value = ListBox1.List(r, 4)
            .TextBox6.Value = ListBox1.List(r, 5)
            .TextBox7.Value = ListBox1.List(r, 6)
            .TextBox8.Value = ListBox1.List(r, 7)
            .TextBox9.Value = ListBox1.List(r, 8)
            .TextBox10.Value = ListBox1.List(r, 9)
            .update.Enabled = True      'allow amendment or
            .Add.Enabled = False       'don't want duplicate
        End With
    End If
End Sub

Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
                Case "TextBox": oCtrl.Value = Empty
                Case "OptionButton": oCtrl.Value = False
            End Select
        Next oCtrl
    End With
End Sub

Private Sub UserForm_Click()

End Sub

Answer 1

你可以看看ListView控件(右键单击工具箱并搜索其他控件，查找 Microsoft ListView Control, version 6.0)。
它不是最现代和最精致的，但可能仍然非常适合您的即时需求。

一些示例可能如下所示:
通过添加 ColumnHeaders 来构建列第一的。然后添加 ListItems (=第一列)每个都分配一组 SubItems (=第 2 列到最后一列，从 1 开始索引)。

Dim l As ListItem
With Me.ListView1
    .FullRowSelect = True
    .LabelEdit = lvwManual
    .View = lvwReport

    For i = 1 To 11
        .ColumnHeaders.Add , , CStr(i)
    Next
    .HideColumnHeaders = False

    Set l = .ListItems.Add(, , c.Text)
    For i = 1 To 10
        l.SubItems(i) = c.Offset(0, i).Text
    Next
End With