通过复选框将工作表保存到新工作簿 [Excel 宏/VBA]

Question

所以我的主要目标是将工作表（取决于它们是否被复选框选中）保存到新工作簿。

这是我的代码：

Sub saveSheetWorkbook()

Dim exampleName As Variant
Dim exampleSavePath As String
Dim exampleSheet As Variant

exampleName = InputBox("Who will this be sent to?")

exampleSavePath = ActiveWorkbook.Path & "\" & exampleName

If Worksheets("Example Worksheet 1").Range("E29") = True Then
exampleSheet = "Example Worksheet 2"
End If

Sheets(Array("Example Worksheet 1"), exampleSheet).Copy
ActiveWorkbook.SaveAs Filename:=exampleSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

例如，我想始终保存示例工作表 1，但仅在选中复选框时才保存示例工作表 2。示例工作表 1 中的单元格 E29 是复选框的链接单元格。

所以这个宏在勾选复选框时有效，但是当取消勾选复选框时，我得到一个错误。

我已对其进行设置，以便工作表数组包含名称或不包含任何内容。但是当不包含任何内容时，这会给我带来错误。

任何帮助都会很棒。

编辑：我需要 6 个不同的复选框/表格。

Answer 1

一个括号太多了

然后

Sub saveSheetWorkbook()

    Dim exampleName As Variant
    Dim exampleSavePath As String
    Dim sheetsArray As Variant

    exampleName = InputBox("Who will this be sent to?")

    exampleSavePath = ActiveWorkbook.Path & "\" & exampleName

    If Worksheets("Example Worksheet 1").Range("E29") Then
        sheetsArray = Array("Example Worksheet 1", "Example Worksheet 2")
    Else
        sheetsArray = Array("Example Worksheet 1")
    End If

    Sheets(sheetsArray).Copy
    ActiveWorkbook.SaveAs Filename:=exampleSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

Answer 2

您可以使用我的示例工作簿通过表单执行此操作： https://drive.google.com/open?id=0BzFv0oeets6ubHg2bk96SHotdkU

要自己创建，请参考以下说明：

1. 按 ALT+F11 打开 VBA 窗口；
2. 创建名为 "Userform1"
的用户表单
3. 将列表框放入表单并将其名称更改为“lstSheet”
4. 更改其属性，如下所示：
   • ListStyle: 1-fmListStyleOPtion;
   • 多选： 1-fmMultiSelectMulti；

用户表单代码：

Option Explicit
Dim NewName As String
Dim ws As Worksheet
Dim NumSheets As Integer


Private Sub CommandButton1_Click()
Dim Count As Integer, i As Integer, j As Integer
Count = 0
For i = 0 To lstSheet.ListCount - 1
    'check if the row is selected and add to count
    If lstSheet.Selected(i) Then Count = Count + 1
Next i
For i = 0 To lstSheet.ListCount - 1
    If lstSheet.Selected(i) Then Sheets(lstSheet.List(i)).Select True

Next i


For i = 0 To lstSheet.ListCount - 1
If lstSheet.Selected(i) Then Sheets(lstSheet.List(i)).Select False
If lstSheet.Selected(i) Then Sheets(lstSheet.List(i)).Activate
Next i
Unload Me
ActiveWindow.SelectedSheets.Copy

For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

         '       Remove named ranges

         '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"

        ActiveWorkbook.Close SaveChanges:=False

      Application.ScreenUpdating = True
End Sub

Private Sub lstSheet_Click()

End Sub

Private Sub UserForm_Initialize()
Dim Sh As Variant
    'for each loop the add visible sheets
    For Each Sh In ActiveWorkbook.Sheets
        'only visible sheetand exclude login sheet
        If Sh.Visible = True Then
            'add sheets to the listbox
            Me.lstSheet.AddItem Sh.Name
        End If
    Next Sh
End Sub

5. 创建模块并将这段代码放在那里：

 
Sub showForm()
  Userform1.Show
End Sub