将列表框中选定的 Excel 工作表保存为新的工作簿/Excel 文件

Posted 2023-05-07

【中文标题】将列表框中选定的 Excel 工作表保存为新的工作簿/Excel 文件

【英文标题】：Saving selected excel sheets in a Listbox as a new workbook/excel file

【发布时间】：2021-12-03 14:28:03

【问题描述】：

我在 Excel 中有一个名为 ListBoxSh 的列表框。以下代码生成 Excel 工作簿中工作表的名称，并可以动态“捕获”选定的工作表。

现在我想要的是用户“选择”的工作表应该保存为一个新的 excel 文件（如果选择了多个工作表，它们都应该在一个文件中）。

大部分都可以，但这段代码似乎不正确

Sheets(SheetArray()).SaveAs Environ("temp") & "\" & FName 

我在下面粘贴了整个代码。我应该在这里改变什么？

Sub test()

Dim i As Long, d As Long, c As Range, FName As String
FName = "Sheet.xls"

    Dim SheetArray() As String
    
    With ActiveSheet.ListBoxSh
    
        For i = 0 To .ListCount - 1
        
            If .Selected(i) Then
    
                ReDim Preserve SheetArray(d)
                SheetArray(d) = .List(i)
                d = d + 1
                
            End If
                    
        Next i
    
    End With
    
Sheets(SheetArray()).SaveAs Environ("temp") & "\" & FName

End Sub

问候，

【参考方案1】：

请尝试下一个代码。它假定列表框是ActiveX 类型：

Sub testSheetListBox()
Dim lbox As MSForms.listBox, i As Long, d As Long, SheetArray()
Set lbox = ActiveSheet.OLEObjects("ListBoxSh").Object
ReDim SheetArray(lbox.ListCount)

With lbox
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                SheetArray(d) = .List(i): d = d + 1
            End If
        Next i
End With
If d > 0 Then
    ReDim Preserve SheetArray(d - 1) 'often ReDim Preserve is not a good way of memory handling
    Sheets(SheetArray).copy 'it creates a new workbook containing the selected sheets...
    ActiveWorkbook.saveas ThisWorkbook.Path & "\Sheet.xls"
Else
    MsgBox "No sheet selected..."
End If
End Sub