多列列表框在传输到数组时使订阅超出范围

Question

昨天，我问如何为列制作数组。早些时候我只需要一个，但现在我有一个多列列表框。使用给我的三个代码，我试图编辑它以查看它是否有效，但我认为我一定做错了。你能告诉我，如果我做对了，这只是我程序的另一部分，或者我只需要修复它。此外，它还给了我

下标超出范围

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

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。没有变化。

Answer 1

既然您正在填充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!")