将多个工作表同时导出到PDF，而不使用ActiveSheet或Select

我遇到的问题是相当简单的描述。

它已经钻进我的脑海（通过对SO和其他Excel VBA论坛/资源的大量阅读），一般来说，为了避免错误并提供良好的用户体验，最好避免使用。select，。 .Activate ， ActiveSheet ， ActiveCell等等写入VBA代码。

牢记这一点：是否有办法在工作簿中的Sheets子集上使用.ExportAsFixedFormat方法，而不使用上述方法之一？ 到目前为止，我已经能够做到这一点的唯一方法是：

1. 使用For Each ; 但是，这会导致分开的PDF文件，这是不好的。

2. 使用类似于macroslogging器生成的代码，该代码使用.Select和ActiveSheet ：

    Sheets(Array("Sheet1", "Chart1", "Sheet2", "Chart2")).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "exported file.pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= True 

有任何想法吗？ 也许这是不可能不使用ActiveSheet ，但我可以至less绕过使用。select某种方式？

编辑：

为了节省任何修补的麻烦，我已经试过这个：

 Sheets(Array("Sheet1", "Chart1", "Sheet2","Chart2")).ExportAsFixedFormatType:= _ xlTypePDF, Filename:= "exported file.pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= _ True 

产生error 438: Object doesn't support this property or method

Answer 1

讨厌一个古老的问题，但我不希望看到有人在这个问题上诉诸其他答案的代码体操。 ExportAsFixedFormat方法只导出可见的工作表和图表。 这是更清洁，更安全，更容易：

 Sub Sample() ToggleVisible False ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ "exported file.pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True ToggleVisible True End Sub Private Sub ToggleVisible(state As Boolean) Dim ws As Object For Each ws In ThisWorkbook.Sheets Select Case ws.Name Case "Sheet1", "Chart1", "Sheet2", "Chart2" Case Else ws.Visible = state End Select Next ws End Sub 

Answer 2

它已钻到我的头上（通过很多….

我知道你是什么意思;）

这里有一个不使用的方法。select.Select/.Activate/ActiveSheet

逻辑 ：

1. 删除不必要的纸张
2. 导出整个工作簿。
3. closures工作簿而不保存，以便您将删除的工作表取回

代码 ：

 Sub Sample() Dim ws As Object On Error GoTo Whoa '<~~ Required as we will work with events '~~> Required so that deleted sheets/charts don't give you Ref# errors Application.Calculation = xlCalculationManual For Each ws In ThisWorkbook.Sheets Select Case ws.Name Case "Sheet1", "Chart1", "Sheet2", "Chart2" Case Else Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End Select Next ws '~~> Use ThisWorkbook instead of ActiveSheet ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "exported file.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, openafterpublish:=True LetsContinue: Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True '~~> VERY IMPORTANT! This ensures that you get your deleted sheets back. ThisWorkbook.Close SaveChanges:=False Exit Sub Whoa: MsgBox Err.Description Resume LetsContinue End Sub 

Answer 3

编辑：高兴地报告，目前接受的答案已经使这个想法完全没有必要。

感谢Siddharth Rout为我提供了一个方法来做到这一点！

编辑：如下面写这个模块主要工作，但不完全; 我遇到的问题是图表不保留其数据后，他们所指的表已被删除（这是尽pipe包含pApp.Calculation = xlCalculationManual命令）。 我一直无法弄清楚如何解决这个问题。 我会做更新。

下面是一个类模块（实现这个答案的方法）来解决这个问题。 希望对某人有用，否则人们可能会对它提供反馈，如果它不适合他们。

WorkingWorkbook.cls

 '**********WorkingWorkbook Class*********' 'Written By: Rick Teachey ' 'Creates a "working copy" of the desired ' 'workbook to be used for any number of ' 'disparate tasks. The working copy is ' 'destroyed once the class object goes out' 'of scope. The original workbook is not ' 'affected in any way whatsoever (well, I ' 'hope, anyway!) ' '''''''''''''''''''''''''''''''''''''''''' Option Explicit Private pApp As Excel.Application Private pWorkBook As Workbook Private pFullName As String Property Get Book() As Workbook Set Book = pWorkBook End Property Public Sub Init(CurrentWorkbook As Workbook) Application.DisplayAlerts = False Dim NewName As String NewName = CurrentWorkbook.FullName 'Append _1 onto the file name for the new (temporary) file Do NewName = Mid(NewName, 1, InStr(Len(NewName) - 4, NewName, ".") - 1) _ & Replace(NewName, ".", "_1.", Len(NewName) - 4, 1) 'Check if the file already exists; if so, append _1 again Loop While (Len(Dir(NewName)) <> 0) 'Save the working copy file CurrentWorkbook.SaveCopyAs NewName 'Open the working copy file in the background pApp.Workbooks.Open NewName 'Set class members Set pWorkBook = pApp.Workbooks(Dir(NewName)) pFullName = pWorkBook.FullName Application.DisplayAlerts = True End Sub Private Sub Class_Initialize() 'Do all the work in the background Set pApp = New Excel.Application 'This is the default anyway so probably unnecessary pApp.Visible = False 'Could probably do without this? Well just in case... pApp.DisplayAlerts = False 'Workaround to prevent the manual calculation line from causing an error pApp.Workbooks.Add 'Prevent anything in the working copy from being recalculated when opened pApp.Calculation = xlCalculationManual 'Also probably unncessary, but just in case pApp.CalculateBeforeSave = False 'Two more unnecessary steps, but it makes me feel good Set pWorkBook = Nothing pFullName = "" End Sub Private Sub Class_Terminate() 'Close the working copy (if it is still open) If Not pWorkBook Is Nothing Then On Error Resume Next pWorkBook.Close savechanges:=False On Error GoTo 0 Set pWorkBook = Nothing End If 'Destroy the working copy on the disk (if it is there) If Len(Dir(pFullName)) <> 0 Then Kill pFullName End If 'Quit the background Excel process and tidy up (if needed) If Not pApp Is Nothing Then pApp.Quit Set pApp = Nothing End If End Sub 

testing程序

 Sub test() Dim wwb As WorkingWorkbook Set wwb = New WorkingWorkbook Call wwb.Init(ActiveWorkbook) Dim wb As Workbook Set wb = wwb.Book Debug.Print wb.FullName End Sub