I'm trying to loop through all active sheets and save them as separate PDFs.
dim ws as worksheet
dim path as string
...
For Each ws In ActiveWindow.SelectedSheets
ws.ExportAsFixedFormat _
xlTypePDF, _
Filename:=path & ws.Name, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenafterPublish:=False
Next
It kind of works:
A PDF file is created for each selected sheet in the correct folder... but...
The contents of those PDF files are all the same. It is the Active Sheet being printed each time but with a different filename.
How to fix this? Keep in mind, I only want selected sheets to print.
EDIT: I'm too new to upvote. Thanks for your answers!
You need to Select the sheet before printing out.
Just add the command ws.Select right before ws.ExportAsFixedFormat and it will work:
For Each ws In ActiveWindow.SelectedSheets
ws.Select '<-- the only thing you have to add.
ws.ExportAsFixedFormat _
xlTypePDF, _
Filename:=path & ws.Name, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenafterPublish:=False
Next
Apart for this:
Tip 1: to avoid seeing the sheets jumping over and over, you can add Application.ScreenUpdating = False before the loop starts and then setting it back to Application.ScreenUpdating = True at the end of the loop.
Tip 2: for user friendliness, you can get the currently active sheet at the beginning of the loop with Dim currentlySelectedSheet As Worksheet: Set currentlySelectedSheet = ActiveSheet and when the loop ends, you just select it back with currentlySelectedSheet.Select so that the user won't see anything change in their screen when running your macro.
Option Explicit
Sub Save_SelectedSheets_AsPdf()
Dim ws As Worksheet
Dim path As String
Dim actSheet As Worksheet
'...
Set actSheet = ActiveSheet
For Each ws In ActiveWindow.SelectedSheets
ws.Select
ws.ExportAsFixedFormat _
xlTypePDF, _
Filename:=path & ws.Name, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenafterPublish:=False
Next
actSheet.Select
End Sub
Sub Create_5_Sheets_and_name_them()
Dim iCt As Integer
For iCt = 2 To 5
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sh" & iCt
Range("A1").Value = ActiveSheet.Name
Next iCt
End Sub
you can specify it like this before you export it to pdf
Related
I have the below script to export each excel sheet to a separate PDF page. It works fine, except for one small issue. I need the range Columns A:H to fit on one PDF page. How can I update the below script to make sure I export all information on one page for the specified columns?
Sub ExportToPDFs()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
nm = ws.Name
ActiveSheet.Columns("A:H").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\My Folder\" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next ws
End Sub
I would set the print area to A:H and set scale to fit to 1 page wide and 1 page high through the Page Setup part of the Ribbon. Then the following code should work without having to mess with the scaling through VBA.
Sub ExportToPDFs()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
nm = ws.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\My Folder\" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next ws
End Sub
On the basis of a few posts I was able to make below script which prints several selected ranges to a pdf file. However, all ranges are printed on a seperate sheet.
Currently NewRng.Address="A1:G9,A13:G14,A18:G37". I think it might need to be "A1:G9;A13:G14;A18:G37" (seperated by ; instead of ,)(?)
Can someone explain how can I print the selected ranges on one sheet?
Thank you so much!
Script:
Sub CreatePDF_Selection1()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim NewRng As Range
With ThisWorkbook.Sheets("Sheet1")
Set rng1 = .Range("A1:G9")
Set rng2 = .Range("A13:G14")
Set rng3 = .Range("A18:G37")
Set NewRng = .Range(rng1.Address & "," & rng2.Address & "," & rng3.Address)
Debug.Print NewRng.Address
Sheets("Sheet1").Activate
ActiveSheet.Range(NewRng.Address).Select
Sheets(Array("Sheet1")).Select
ThisWorkbook.Sheets(Array("Sheet1")).Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="U:\Sample Excel File Saved As PDF", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
From:=1, _
OpenAfterPublish:=True
End With
End Sub
Rather than select various ranges just hide the rows you don't want to print then print the entire range.
Option Explicit
Sub CreatePDF_Selection1()
Dim rng1 As Range
ThisWorkbook.Sheets("Sheet1").Activate
Set rng1 = Range("A1:G37")
Range("A10:A12").EntireRow.Hidden = True '*** Hide rows not to print ***
Range("A15:A17").EntireRow.Hidden = True
rng1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="U:\Sample Excel File Saved As PDF", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
From:=1, _
OpenAfterPublish:=True
Rows("1:37").EntireRow.Hidden = False '*** Unhide hidden rows ***
End Sub 'CreatePDF_Selection1()
HTH
Edit: Attach test output.
I could not find a direct solution, so there is a work about here. A new worksheet will be added. The content will be copied there as a continuous range. The sheet will be exported as PDF, than the not needed sheet will be deleted.
Sub CreatePDF_Selection1()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim NewRng As Range
Application.ScreenUpdating = False
With Sheet1
Set rng1 = .Range("A1:G9")
Set rng2 = .Range("A13:G14")
Set rng3 = .Range("A18:G37")
Set NewRng = Union(rng1, rng2, rng3)
End With
'Creating test values
rng1.Value = "Test 1"
rng2.Value = "Test 2"
rng3.Value = "Test 3"
NewRng.Copy
'adding a new sheet
Worksheets.Add after:=Sheet1
With ActiveSheet
.Paste
.ExportAsFixedFormat, _
Type:=xlTypePDF, _
Filename:="U:\Sample Excel File Saved As PDF", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
From:=1, _
OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete 'delete the unwanted worksheet
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
End Sub
Export Non-Contiguous Range to PDF
This solution uses the Application.Union method to create the range to be exported. The range is then copied using the Range.Copy method to a newly added worksheet and exported from there. Then the newly added worksheet is deleted.
Option Explicit
Sub CreatePDF_Selection1()
Const FilePath As String = "U:\Sample Excel File Saved As PDF"
Const SheetName As String = "Sheet1"
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
' Define Copy Range.
With wb.Worksheets(SheetName)
Dim rng As Range
Set rng = Union(.Range("A1:G9"), .Range("A13:G14"), .Range("A18:G37"))
End With
' Copy Copy Range to new worksheet, export to PDF and delete new worksheet.
With Worksheets.Add
' This will copy values and formats.
rng.Copy .Range("A1")
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=FilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
I would like to eligible my PDF document to save, although within the sheets with specified color.
How can I do that?
Sub SavecolorTabtoPDF()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Tab Color = "Blue, Accent 1, Darker 25%" Then
'export as pdf
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\" & Left(ws.Name, Len(ws.Name) - 2) & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
Next ws
End Sub
You want to loop through the sheets and create an array of sheets based on tab color.
This will create your array of sheets, then pdf them as one.
Sub MakeArraySheets()
Dim sh As Worksheet
Dim ArraySheets() As String
Dim x As Variant
For Each sh In ActiveWorkbook.Worksheets
If sh.Tab.ColorIndex = 55 Then
ReDim Preserve ArraySheets(x)
ArraySheets(x) = sh.Name
x = x + 1
End If
Next sh
Sheets(ArraySheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & ThisWorkbook.Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
dim wsheet as worksheet
For Each wsheet In Thisworkbook.Worksheets
if wsheet.tab.colorindex = 1 then
Worksheet.SaveAs(*parameters*)
end if
next wsheet
EDIT: The colorindex for your specified color is 55. Find out by filling a cell with that color and running "mgbox activecell.interior.colorindex"
EDIT2: Removed "interior" before colorindex
So I'm using this macro to save individual excel worksheets as their own PDF when run:
Sub SaveWorksheetsAsPDFs()
Dim sFile As String
Dim sPath As String
Dim wks As Worksheet
With ActiveWorkbook
sPath = .Path & "\"
For Each wks In .Worksheets
sFile = wks.Name & ".pdf"
wks.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sPath & sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next wks
End With
End Sub
I would just like to add to it to not start from a certain worksheet or to exclude certain worksheets. Any clue how?
You can use Select Case to specify sheetnames to ignore, as shown. Simply replace the "IgnoreSheet1", "IgnoreSheet2" with the actual sheet names you want skipped. It's just a comma delimited list, so add as many as you want.
Sub SaveWorksheetsAsPDFs()
Dim sFile As String
Dim sPath As String
Dim wks As Worksheet
With ActiveWorkbook
sPath = .Path & "\"
For Each wks In .Worksheets
Select Case wks.Name
Case "IgnoreSheet1", "IgnoreSheet2" 'Do nothing
Case Else
'Code here to run on the other sheets
sFile = wks.Name & ".pdf"
wks.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sPath & sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Select
Next wks
End With
End Sub
I have a workbook with many worksheets. I would like to save as two-page PDFs, where the first page is Worksheet 1, and the second page is Worksheets 2-x. My code currently only allows me to save individual PDFs for each worksheet in the workbook. I am wondering what to add to it to make it do this. Can anyone share some advice?
Thanks!
Option Explicit
Sub createPDFfiles()
Dim ws As Worksheet
Dim Fname As String
For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Fname = "C:\Folder\" & ws.Name & "Report" & Format(Date, "yyyy-mm-dd") & ".pdf"
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False
Next ws
End Sub
You are enumerating through the worksheets and doing your save inside that loop. That is why you are getting one PDF per worksheet. Try using just workbook instead of ActiveWorkbook.Worksheets.
Gah. It was staring me in the face the whole time. I amended the code to include a selection, and named the second worksheet ws.Name. Final script looks like this:
Option Explicit
Sub createPDFfiles()
Dim ws As Worksheet
Dim Fname As String
For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Fname = "C:\Folder\" & ws.Name & "Report" & Format(Date, "yyyy-mm-dd") & ".pdf"
Sheets(Array("Sheet1", ws.Name)).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False
Next ws
End Sub
Thanks for your help everyone!