Userform Listbox项目为字符串，其中每个项目引用活动工作表

时间：2017-03-21 10:57:57

标签： excel range listboxitem

后台：我有一个包含A:AN列的Excel文件。工作表用于跟踪多个部件的状态。每个零件1行，每列指的是被跟踪零件的不同元素。 （供应商，重量等）

在工作表中，我有一个生成报告的宏，它选择一个预定义的列范围，将它们复制到一个新工作簿中，并为其提供时间戳和一些格式，使其成为我想要的报告格式。这是一个魅力，没有问题。

我的问题现在我希望用户能够选择他们想要包含在报告中的列。我创建了一个带有两个列表框的用户表单。 ListBox1具有每列的标题，我已设置控制按钮以允许单个或多个项目选择并将它们移动到ListBox2。我想这样，当单击一个命令按钮时，ListBox2中显示的每个项目都代表一个列，它们将被组合成一个范围，然后可以用于我的原始代码来创建报告。

我在这一个上画了一个完整的空白。一切都在努力实际使用ListBox2中的项目，以一种有用的方式生成一个范围，该范围可以在我的代码中稍后使用。关于我应该如何进行的任何想法？任何帮助将不胜感激。

到目前为止我尝试的是： 1）添加ItemData，引用我的每个AddItem命令下面的范围 - 这导致编译错误Compile Error

2）将每个列标题声明为范围，我尝试将范围作为AddItem添加到列表框中，但是我遇到了运行时错误。 Run-Time Error

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

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

0 个答案:

没有答案
相关问题
最新问题