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

要自己创建，请按以下说明操作：

按ALT + F11打开VBA窗口;
创建名称为＆＃34; Userform1＆＃34;
将列表框放入表单并将其名称更改为＆＃34; lstSheet＆＃34;
更改其属性，如下所示：
- 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

创建模块并将此代码放在那里：

 
Sub showForm()
  Userform1.Show
End Sub

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

2 个答案: