Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/82.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel Userform Listbox项作为字符串,其中每个项引用活动工作表上的列范围_Excel_Range_Listboxitem - Fatal编程技术网

Excel Userform Listbox项作为字符串,其中每个项引用活动工作表上的列范围

Excel Userform Listbox项作为字符串,其中每个项引用活动工作表上的列范围,excel,range,listboxitem,Excel,Range,Listboxitem,背景:我有一个excel文件,其中列来自A:an。该图纸用于跟踪多个零件的状态。每个零件1行,每列表示正在跟踪的零件的不同元素。(供应商、重量等) 在工作表中,我有一个宏来生成一个报告,它选择一个预定义的列范围,将它们复制到一个新的工作簿中,并给它一个时间戳和一些格式,使其成为我想要的报告格式。这很有魅力,没问题 我的问题是现在我希望用户能够选择他们希望包含在报告中的列。我创建了一个带有两个列表框的用户表单。ListBox1具有每列的标题,我设置了控制按钮以允许选择单个或多个项目,并将它们移动到

背景:我有一个excel文件,其中列来自
A:an
。该图纸用于跟踪多个零件的状态。每个零件1行,每列表示正在跟踪的零件的不同元素。(供应商、重量等)

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

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

我在这件事上完全是一片空白。一切都在以一种有用的方式实际使用ListBox2中的项来生成一个范围,该范围可以在以后的代码中使用。我该怎么做有什么想法吗?任何帮助都将不胜感激

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

2) 将每个列标题声明为一个范围,我试图将该范围作为一个附加项添加到列表框中,但出现了一个运行时错误

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

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

一些图片可能对我们有很大帮助。如果您有错误,请向我们展示您的代码,并告诉我们错误在哪里。很抱歉,我没有发布任何图像或代码,因为我甚至不知道如何解决问题,也没有太多可显示的内容。我考虑过将列表框项目设置为数组,但不知道如何将其链接到每个项目的范围。我还开始为每个列标题声明一个范围,并将其作为ItemData添加到每个addItem命令下面,但这也不起作用。当我明天回到我的办公桌前时,我将分享到目前为止我掌握的代码。但是,如果你有一个关于我如何能正确设置这将是伟大的想法!一些图片可能对我们有很大帮助。如果您有错误,请向我们展示您的代码,并告诉我们错误在哪里。很抱歉,我没有发布任何图像或代码,因为我甚至不知道如何解决问题,也没有太多可显示的内容。我考虑过将列表框项目设置为数组,但不知道如何将其链接到每个项目的范围。我还开始为每个列标题声明一个范围,并将其作为ItemData添加到每个addItem命令下面,但这也不起作用。当我明天回到我的办公桌前时,我将分享到目前为止我掌握的代码。但是,如果你有一个关于我如何能正确设置这将是伟大的想法!