用户窗体列表框项目作为string,其中每个项目引用活动工作表上的列范围

背景:我有一个从A:AN列的Excel文件。 工作表用于跟踪多个零件的状态。 每部分1行,每列指的是被跟踪部分的不同元素。 (供应商,重量等)

在工作表中,我有一个macros来生成一个报告,它select一个预定义的列的范围,将它们复制到一个新的工作簿,并给它一个时间戳加上一点格式,使之成为我想要的报告格式。 这工作魅力,没有问题。

我的问题是 ,现在我希望用户能够select他们想要包含在报告中的列。 我用两个列表框创build了一个用户表单。 ListBox1有每列的标题,我已经设置了控制button,以允许单个或多个项目select,并将其移动到ListBox2。 我喜欢它,当单击命令button时,ListBox2中显示的每个项目将代表一个列,他们将被合并到一个范围,然后可以用于我的原始代码来创build报告。

我已经在这一个完整的空白。 一切都在实际使用ListBox2中的项目,以一种有用的方式来生成一个范围,可以在我的代码中使用后面的行。 任何想法,我应该如何进行? 任何帮助将非常感激。

我到目前为止所尝试的是:1)添加引用每个AddItem命令下面的范围的ItemData – 这导致编译错误编译错误

2)将每个列标题声明为一个范围,我尝试将范围作为一个AddItem添加到列表框中,但我得到了一个运行时错误。 运行时错误

正如我所说,其余用户表单的代码正在做我想要的,但我不知道如何克服或设置下一步。 我已经包含了我所有的代码供您参考。 除列表框之外,还有更简单的方法吗?

 Private Sub cmdMoveAllLeft_Click() 'Variable Declaration Dim iCnt As Integer 'Move Items from ListBox1 to ListBox2 For iCnt = 0 To Me.ListBox2.ListCount - 1 Me.ListBox1.AddItem Me.ListBox2.List(iCnt) 'Me.ListBox1.ItemData(.NewIndex) = Me.ListBox2.ItemData(iCnt) Next iCnt 'Clear ListBox1 After moving Items from ListBox1 to ListBox2 Me.ListBox2.Clear End Sub Private Sub cmdMoveAllRight_Click() 'Variable Declaration Dim iCnt As Integer 'Move Items from ListBox1 to ListBox2 For iCnt = 0 To Me.ListBox1.ListCount - 1 Me.ListBox2.AddItem Me.ListBox1.List(iCnt) 'Me.ListBox2.ItemData(.NewIndex) = Me.ListBox1.ItemData(iCnt) Next iCnt 'Clear ListBox1 After moving Items from ListBox1 to ListBox2 Me.ListBox1.Clear End Sub Private Sub cmdMoveSelLeft_Click() 'Variable Declaration Dim iCnt As Integer 'Move Selected Items from Listbox1 to Listbox2 For iCnt = 0 To Me.ListBox2.ListCount - 1 If Me.ListBox2.Selected(iCnt) = True Then Me.ListBox1.AddItem Me.ListBox2.List(iCnt) 'Me.ListBox1.ItemData(.NewIndex) = Me.ListBox2.ItemData(iCnt) End If Next For iCnt = Me.ListBox2.ListCount - 1 To 0 Step -1 If Me.ListBox2.Selected(iCnt) = True Then Me.ListBox2.RemoveItem iCnt End If Next End Sub Private Sub cmdMoveSelRight_Click() 'Variable Declaration Dim iCnt As Integer 'Move Selected Items from Listbox1 to Listbox2 For iCnt = 0 To Me.ListBox1.ListCount - 1 If Me.ListBox1.Selected(iCnt) = True Then Me.ListBox2.AddItem Me.ListBox1.List(iCnt) 'Me.ListBox2.ItemData(.NewIndex) = Me.ListBox1.ItemData(iCnt) End If Next For iCnt = Me.ListBox1.ListCount - 1 To 0 Step -1 If Me.ListBox1.Selected(iCnt) = True Then Me.ListBox1.RemoveItem iCnt End If Next End Sub Private Sub CommandButton1_Click() Call ListboxArray Call GenerateReport End Sub Private Sub ListboxArray() Dim vArray() As String Dim LB2Array() As Variant Dim i As Long LB2Array = SelectColumns.ListBox2.List 'creates a 2-dimensional variant array from list contents ReDim vArray(UBound(LB2Array, 1)) For i = 0 To UBound(LB2Array, 1) vArray(i) = LB2Array(i, 0) Next MsgBox "Your listbox contains: " & vbCrLf & Join(vArray, vbCrLf) End Sub Private Sub GenerateReport() 'Unlock Sheet On Error Resume Next ActiveSheet.Unprotect Password:="LBFD16" Range(output of list box 2).Select '(Unsure of how to make the items from ListBox2 into the required range) Selection.Copy Workbooks.Add Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste 'Format sheet Range("A1:J1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge ActiveCell.FormulaR1C1 = _ "**THIS DATA IS AN EXTRACT FROM THE LIVE TRACKING DOCUMENT FOR THIS VEHICLE PROGRAM - FOR LATEST STATUS PLEASE CONSULT THE LIVE PACKAGE TRACKER**" Range("A1:J1").Select Selection.Font.Bold = True Selection.Font.Italic = True With Selection.Font .Color = -16776961 .TintAndShade = 0 End With Range("E2:G2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("E2:G2").Select ActiveCell.FormulaR1C1 = "THIS DATA WAS EXTRACTED ON -" Range("H2").Select Application.ActiveCell.Value = Now() Range("H2").Select Selection.NumberFormat = "[$-409]d/m/yy h.mm AM/PM;@" With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("H2").Activate Selection.ColumnWidth = 16 Range("E2:G2").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With 'Save Report ActiveWorkbook.SaveAs FileName:=Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Excel File (*.xlsx),*.xlsx"), _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'Switch back to original tracker Windows("LB636 ELECTRICAL PACKAGE TRACKER.xlsm").Activate 'Lock sheet On Error Resume Next ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowInsertingHyperlinks:=True, Password:="LBFD16" End Sub Private Sub UserForm_Initialize() 'Dim Initial_Check_Complete As Range 'Set Initial_Check_Complete = ActiveSheet.Range("A:A") With ListBox1 .AddItem "Initial_Check_Complete" '.ItemData(.NewIndex) = ActiveSheet.Range("A:A") .AddItem "Part Description (English)" '.ItemData(.NewIndex) = ActiveSheet.Range("C:C") .AddItem "Apperance" '.ItemData(.NewIndex) = ActiveSheet.Range("D:D") .AddItem "Part Description (German)" '.ItemData(.NewIndex) = ActiveSheet.Range("E:E") 'more items continue End With End Sub