为了避免错误并提供良好的用户体验，我已经深入挖掘，最好避免使用.Select，.Activate，ActiveSheet，ActiveCell等等。
记住这一点，有没有办法在工作簿的.ExportAsFixedFormat子集上使用Sheets方法而不使用上述方法之一？到目前为止，我能够做到这一点的唯一方法是：
For Each;但是，这导致单独的PDF文件，这是不好的。使用类似于宏录制器生成的代码，该代码使用.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，但我能不能以某种方式使用.Select来解决这个问题？
我试过这个：
Sheets(Array("Sheet1", "Chart1", "Sheet2","Chart2")).ExportAsFixedFormatType:= _
xlTypePDF, Filename:= "exported file.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= _
True
这会产生：
错误438：对象不支持此属性或方法
答案 0 :(得分：21)
讨厌疏通一个老问题，但是我讨厌看到有人在这个问题上磕磕绊绊地诉诸于其他答案中的代码体操。 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
答案 1 :(得分：14)
它钻进了我的脑海（通过很多......
我知道你是什么MEAN;）
以下是一种不使用.Select/.Activate/ActiveSheet
逻辑：
<强>代码：
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
答案 2 :(得分：3)
编辑：很高兴地报告，现在当前接受的答案使得这个想法完全没必要。
感谢Siddharth Rout为我提供了实现这一目标的想法！
编辑：如下所述，这个模块大部分都有效，但并非完整;我遇到的问题是图表在他们引用的工作表被删除后没有保留他们的数据（尽管包含了pApp.Calculation = xlCalculationManual命令）。我一直无法弄清楚如何解决这个问题。我会更新。
下面是一个类模块（实现this answer的方法）来解决这个问题。希望它对某人有用，或者如果它对他们不起作用，人们可以提供反馈。
'**********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
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
答案 3 :(得分：0)
一个选项，无需创建新的WB：
Option Explicit
Sub fnSheetArrayPrintToPDF()
Dim strFolderPath As String
Dim strSheetNamesList As String
Dim varArray() As Variant
Dim bytSheet As Byte
Dim strPDFFileName As String
Dim strCharSep As String
strCharSep = ","
strPDFFileName = "SheetsPrinted"
strSheetNamesList = ActiveSheet.Range("A1")
If Trim(strSheetNamesList) = "" Then
MsgBox "Sheet list is empty. Check it. > ActiveSheet.Range(''A1'')"
GoTo lblExit
End If
For bytSheet = 0 To UBound(Split(strSheetNamesList, strCharSep, , vbTextCompare))
ReDim Preserve varArray(bytSheet)
varArray(bytSheet) = Trim(Split(strSheetNamesList, strCharSep, , vbTextCompare)(bytSheet))
Next
strFolderPath = Environ("USERPROFILE") & "\Desktop\pdf\"
On Error Resume Next
MkDir strFolderPath
On Error GoTo 0
If Dir(strFolderPath, vbDirectory) = "" Then
MsgBox "Err attempting to create the folder: '" & strFolderPath & "'."
GoTo lblExit
End If
Sheets(varArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFolderPath & strPDFFileName, _
OpenAfterPublish:=False, IgnorePrintAreas:=False
MsgBox "Print success." & vbNewLine & " Folder: " & strFolderPath, vbExclamation, "Printing to PDF"
lblExit:
Exit Sub
End Sub