通过复选框将工作表保存到新工作簿中[Excel Macro / 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；
   • MultiSelect： 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