下午
我只是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
答案 0 :(得分：0)
您可以查看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