我的宏中有一个非常旧的Excel电子表格。
使用方法是:启动电子表格,按下按钮,选择其他一些电子表格,完成复制并粘贴到一个电子表格文件中。
它适用于Office Excel 2007,但不适用于Office 2013。
当宏启动时,一旦选择了要追加的文件,Excel将报告:
运行时错误:1004
无法获取ListBox类的ListIndex属性
然后,当我点击debug时,它将此VBA行标记为黄色:
Set wbData = Workbooks.Open(wbLauncher.Worksheets("config").Cells(Worksheets("config").Range("Program1").Row - 1 + shtActive.Shapes(1).ControlFormat.ListIndex, Worksheets("config").Range("Program1").Column), , True)
编辑添加整个代码
Sub btnSelectData()
Dim fd As FileDialog, shtActive As Worksheet, fItem As Variant, cID As Integer, rID As Integer
Set shtActive = ActiveSheet
shtActive.Range("D:D").ClearContents
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.AllowMultiSelect = True
fd.InitialFileName = Worksheets("config").Range("dataPath")
fd.Show
cID = Worksheets("GUI").Range("Data1").Column
rID = Worksheets("GUI").Range("Data1").Row
For Each fItem In fd.SelectedItems
shtActive.Cells(rID, cID) = fItem
rID = rID + 1
Next
End Sub
Public Sub LoadData(ByVal fName As String)
Dim shtActive As Worksheet, wbData As Workbook
Set shtActive = ActiveSheet
shtActive.Cells(1, 1).Select
If fName <> "" Then
Set wbData = Workbooks.Open(fName, , True)
If wbData.Worksheets.Count < 1 Then
MsgBox "No data found in " & fName
Else
wbData.Worksheets(1).Cells.Select
Selection.Copy
shtActive.Activate
ActiveSheet.Paste
shtActive.Cells(1, 1).Select
End If
Selection.Clear
wbData.Close
End If
End Sub
Sub btnLaunch()
Dim wbLauncher As Workbook, shtActive As Worksheet, wbData As Workbook, shtItem As Worksheet
Set wbLauncher = ActiveWorkbook
Set shtActive = ActiveSheet
Application.WindowState = xlMinimized
Set wbData = Workbooks.Open(wbLauncher.Worksheets("config").Cells(Worksheets("config").Range("Program1").Row - 1 + shtActive.Shapes(1).ControlFormat.ListIndex, Worksheets("config").Range("Program1").Column), , True)
For Each shtItem In wbData.Worksheets
If UCase(Left(shtItem.Name, 5)) = "DATA_" Then
shtItem.Activate
LoadData wbLauncher.Worksheets("GUI").Cells(wbLauncher.Worksheets("GUI").Range("Data1").Row - 1 + Val(Right(shtItem.Name, Len(shtItem.Name) - 5)), wbLauncher.Worksheets("GUI").Range("Data1").Column)
End If
Next
wbData.Worksheets(1).Activate
Application.WindowState = xlNormal
End Sub
答案 0 :(得分:0)
我添加了一个循环,它通过列表框并检查它是否被选中,如果是,它会像以前那样执行代码,但是一直持续到检查所有列表框项目为止。
Sub btnLaunch()
Dim wbLauncher As Workbook, shtActive As Worksheet, wbData As Workbook, shtItem As Worksheet
Dim i As Long
Set wbLauncher = ActiveWorkbook
Set shtActive = ActiveSheet
Application.WindowState = xlMinimized
For i = 1 To shtActive.ListBoxes(1).ListCount
If shtActive.ListBoxes(1).Selected(i) Then
Set wbData = Workbooks.Open(wblauncer.Worksheets("Config").Cells(Worksheets("confige").Range("Program1") - 1 + i, Worksheets("Config").Range("Program1").Column), , True)
For Each shtItem In wbData.Worksheets
If UCase(Left(shtItem.Name, 5)) = "DATA_" Then
shtItem.Activate
LoadData wbLauncher.Worksheets("GUI").Cells(wbLauncher.Worksheets("GUI").Range("Data1").Row - 1 + Val(Right(shtItem.Name, Len(shtItem.Name) - 5)), wbLauncher.Worksheets("GUI").Range("Data1").Column)
End If
Next shtItem
wbData.Worksheets(1).Activate
Next i
Application.WindowState = xlNormal
End Sub
<小时/> 您必须在工作表上将列表框的选择类型设置为&#34; Single&#34;,您收到错误的原因是因为当前它被设置为&#34; Multi&#34;或&#34;延伸&#34;。您可以右键单击列表框,然后单击&#34;格式控制&#34;
我找到的所有信息都表明,当选择类型设置为&#34;单个&#34;
时,FormatControl.ListIndex
属性不起作用
查看您的代码,无论如何选择多行似乎都是不合逻辑的。 Workbook.Open
当时只能打开一个文件。您当然可以将它合并到一个循环中以打开多个工作簿,但事实并非如此。
使用调试器突出显示的行:
Set wbData = Workbook.Open("Filename as String", ,"Read only")
代码中的文件名设置如下:
bLauncher.Worksheets("config").Cells(Worksheets("config").Range("Program1").Row - 1 + shtActive.Shapes(1).ControlFormat.ListIndex, Worksheets("config").Range("Program1").Column)
“守则”是指一个名为“#34; Config&#34;”的工作表。在此工作表上,
引用了一个单元格Cells(Rowindex, Columnindex)
Row-和Columnindex是指数字所在的rownumber和列的数字。例如单元格A2
是Cells(2, 1)
单元格E34
是“单元格(34,5)
您的代码是将Rowindex设置如下
Worksheets("config").Range("Program1").Row - 1 + shtActive.Shapes(1).ControlFormat.ListIndex
这个位指的是一个名为&#34; Pgrogam1&#34;在工作表上#34; Config&#34; .row
返回此范围所在的rownumber。然后从该数字中减去1,然后添加选择的listindex以到达保存与列表框中的选择相对应的文件名的单元格。
列表框中的多项选择意味着您尝试打开多个单元格并使用当前的代码即使在2007年的办公室也是如此。