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（=第一列），每个都分配一个集合ófSubItems（=第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

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

1 个答案: