多列列表框在转移到阵列时使订阅超出范围

时间:2017-07-20 15:37:23

标签: arrays excel vba excel-vba listbox

Yesterday,我问过如何为列创建数组。早些时候我只需要一个,但现在我有一个多列列表框。使用给我的三个代码,我试图编辑它以查看它是否有效,但我认为我必须做错了。如果我做得正确,它可以告诉我,这只是我的程序的另一部分,或者我只需要修复它。另外它给了我

  

下标超出范围

这是我认为需要检查的部分:

Private Sub CommandButton1_Click()

Dim listboxarr()
Dim i As Long, j As Long
Dim found As Boolean

With Me.selecteditems
    For i = 0 To .ListCount - 1
        For h = 1 To 2
        If .Selected(i) Then
            found = True
            j = j + 1
            k = k + 1
            ReDim Preserve listboxarr(1 To j)
            listboxarr(j, k) = .List(i, h)
        End If
    Next i
End With

End Sub

如果您想知道这是我使用它的地方。这将获取项目并建立格式,稍后将使用该格式在列表框selecteditems中添加和删除项目项。然后将其发送到上述任务,该任务选择所选对象并将其放入数组中,以便稍后将其用于打印到电子邮件中

Private Sub UserForm_Initialize()

For Each itemname In itemsheet.Range("A2:A3400")
    With Me.allitems
        .ColumnCount = 2
        .ColumnWidths = "60;60"
        .AddItem itemname.Value
        .List(i, 0) = itemnum
        .List(i, 1) = Description
        i = i + 1
    End With
Next itemname

For Each itemname In itemsheet.Range("A2:A3400")
    With Me.selecteditems
        .ColumnCount = 2
        .ColumnWidths = "60;60"
        .List(i, 0) = itemnum
        .List(i, 1) = Description
        i = i + 1
    End With
Next itemname

End Sub


Private Sub addcb_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.allitems.ListCount - 1
        If Me.allitems.Selected(iCtr) = True Then
            Me.selecteditems.AddItem Me.allitems.List(iCtr)
        End If
    Next iCtr

    For iCtr = Me.allitems.ListCount - 1 To 0 Step -1
        If Me.allitems.Selected(iCtr) = True Then
            Me.allitems.RemoveItem iCtr
        End If
    Next iCtr


End Sub


Private Sub removecb_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.selecteditems.ListCount - 1
        If Me.selecteditems.Selected(iCtr) = True Then
            Me.allitems.AddItem Me.selecteditems.List(iCtr)
        End If
    Next iCtr

    For iCtr = Me.selecteditems.ListCount - 1 To 0 Step -1
        If Me.selecteditems.Selected(iCtr) = True Then
            Me.selecteditems.RemoveItem iCtr
        End If
    Next iCtr
End Sub

编辑:我试图删除我添加的内容甚至是selecteditems。没有变化。

1 个答案:

答案 0 :(得分:0)

由于您正在填充listboxarr以在电子邮件正文中显示所选项目,为什么不声明一个包含列表框中所有选定项目的字符串变量。

所以尝试下面的内容......

Private Sub CommandButton1_Click()
Dim i As Long, j As Long, ii As Long
Dim found As Boolean
Dim str As String
With Me.SelectedItems
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            found = True
            For ii = 0 To .ColumnCount - 1
                If str = "" Then
                    str = .List(i, ii) & vbTab
                Else
                    If ii < .ColumnCount - 1 Then
                        str = str & .List(i, ii) & vbTab
                    Else
                        str = str & .List(i, ii)
                    End If
                End If
            Next ii
            str = str & vbNewLine
        End If
    Next i
End With
End Sub

然后使用字符串变量在电子邮件正文中显示所选项目,如...

.body = IIf(found, str, "No item selected!")