多列列表框給予訂閱超出範圍轉移到陣列

Question

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 

EDIT：我試圖刪除我加了什麼，甚至是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!")