VBA to save only Visible cells in PDF

dmbpt

New Member
Joined
Nov 22, 2012
Messages
7
Hi guys,

I have the following code (below) which saves my active worksheet as a PDF. It works fine, however, my sheet has approximately 8000 rows, with an autofilter and the information i see on the screen is not reflected on the PDF (i.e: the info I have is 300 rows, but my PDF shows the full 215 page report - mostly consisting of blank pages...)

How can i create a PDF displaying ONLY visible rows/cells?

Thanks

This is the code:

Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler


Set ws = ActiveSheet


'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
& "_" _
& Sheet18.Cells(14, 17) _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile


myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")


If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True


MsgBox "PDF created"
End If


exitHandler:
Exit Sub
errHandler:
MsgBox "PDF not created"
Resume exitHandler
End Sub
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,121
Office Version
  1. 365
Platform
  1. Windows
Click the # icon to insert code tags. Paste code between them.

Add a scratch worksheet in the current workbook or a scratch workbook. Example of former:
Code:
Sub Main()
  Dim MyFile As String, ws As Worksheet, wsScratch As Worksheet
  
  MyFile = Environ("temp") & "\ken.pdf"
  Set ws = ActiveSheet
  
  Set wsScratch = Worksheets.Add(After:=Worksheets(Worksheets.Count))
  
  ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsScratch.Range("A1")

  wsScratch.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=MyFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
  
  Application.DisplayAlerts = False
  wsScratch.Delete
  Application.DisplayAlerts = True
End Sub
 
Last edited:

dmbpt

New Member
Joined
Nov 22, 2012
Messages
7
Hi Kenneth,

Thank you for your reply. It doesn't seem to be working. i think its because of the range i put in "ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsScratch.Range("C17:BN7954")".

I used your code to complete mine:

Sub PDFActiveSheet()
Dim ws As Worksheet, wsScratch As Worksheet
Dim strPath As String
Dim MyFile As Variant
Dim strFile As String
On Error GoTo errHandler




Set ws = ActiveSheet


'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
& "_" _
& Sheet18.Cells(14, 17) _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile


MyFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")


If MyFile <> "False" Then

Set wsScratch = Worksheets.Add(After:=Worksheets(Worksheets.Count))

ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsScratch.Range("C17:BN7954")


wsScratch.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=MyFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

Application.DisplayAlerts = False
wsScratch.Delete
Application.DisplayAlerts = True


MsgBox "PDF criado com sucesso!"
End If


exitHandler:
Exit Sub
errHandler:
MsgBox "Não foi possível criar o PDF"
Resume exitHandler
End Sub

Click the # icon to insert code tags. Paste code between them.

Add a scratch worksheet in the current workbook or a scratch workbook. Example of former:
Code:
Sub Main()
  Dim MyFile As String, ws As Worksheet, wsScratch As Worksheet
  
  MyFile = Environ("temp") & "\ken.pdf"
  Set ws = ActiveSheet
  
  Set wsScratch = Worksheets.Add(After:=Worksheets(Worksheets.Count))
  
  ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsScratch.Range("A1")

  wsScratch.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=MyFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
  
  Application.DisplayAlerts = False
  wsScratch.Delete
  Application.DisplayAlerts = True
End Sub
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,121
Office Version
  1. 365
Platform
  1. Windows
Again, please paste code between code tags. There is no need to quote all code or a reply. Just say see post #2 if needed.

Right. Ok, let's think about what you told Excel to do with this line:
Code:
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsScratch.Range("C17:BN7954")
You are telling Excel to paste copied columns and rows however big or small, to a set column and row size. Excel does not like that. While one can determine the number of columns and rows in such cases, it is easier to just paste to the top left cell. In your case, I guess it would be:
Code:
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsScratch.Range("C17")
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,123,312
Messages
5,600,887
Members
414,414
Latest member
neil_c

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top