通過復選框將工作表保存到新工作簿中[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