Listbox - Run-time 380 error недопустимое значение свойства

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