It has been drilled into my head, to avoid bugs and provide a good user experience, it is best to avoid using .Select
, .Activate
, ActiveSheet
,ActiveCell
, etc.
Keeping this in mind, is there a way to use the .ExportAsFixedFormat
method on a subset of Sheets
in a workbook without employing one of the above? So far the only ways I have been able to come up with to do this are to either:
For Each
; however, this results in separate PDF files, which is no good.use the code similar to that generated by the macro recorder, which uses .Select
and ActiveSheet
:
Sheets(Array("Sheet1", "Chart1", "Sheet2", "Chart2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"exported file.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= True
Perhaps it is impossible not to use ActiveSheet
, but can I at least get around using .Select
somehow?
I have tried this:
Sheets(Array("Sheet1", "Chart1", "Sheet2","Chart2")).ExportAsFixedFormatType:= _
xlTypePDF, Filename:= "exported file.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= _
True
This produces:
error 438: Object doesn't support this property or method
If you have multiple worksheets and want to save all of them in the same PDF file, click Options in the Save As dialog box. The Options dialog box will appear. Select Entire workbook, then click OK.
(1) In the worksheet name section, please check the worksheets that you will save as separate PDF files; (2) Check the Specify save format option; (3) Click the drop down list under Specify save format option, and select PDF (*. pdf) from it.
Hate to dredge up an old question, but I'd hate to see somebody stumbling across this question resort to the code gymnastics in the other answers. The ExportAsFixedFormat
method only exports visible Worksheets and Charts. This is much cleaner, safer, and easier:
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
It has been drilled into my head (through lots of....
I know what do you MEAN ;)
Here is one way which doesn't use .Select/.Activate/ActiveSheet
Logic:
Code:
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
EDIT: Happy to report that the now current accepted answer has made this idea entirely unnecessary.
Thanks to Siddharth Rout for providing me with the idea for a way to do this!
EDIT: As written below this module mostly works but not entirely; the problem I am having is the charts do not keep their data after the sheets they refer to have been deleted (this is despite the inclusion of the pApp.Calculation = xlCalculationManual
command). I haven't been able to figure out how to fix this. Will update when I do.
Below is a class module (implementing the methodology of this answer) to solve this problem. Hopefully it will be useful for someone, or people could offer feedback on it if it doesn't work for them.
'**********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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With