PDA

View Full Version : Printing range of sheets in excel or in PDF



excel_learner
10-15-2011, 05:46 PM
I have following macro which prints from the ranges defined, but if i want to print the same ranges and save them in one excel file as sheets separately. And also if i want to print the same and save as pdf file.


Sub Print_Ranges()
Dim strShtname As String, strRngName As String
Dim i As Long

With Worksheets("INDEX")

'sort the named range list according to page number order
.Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

'loop through the cells and determine parent of named range and specific range addresses
For i = 3 To 38
strRngName = .Cells(i, 2).Text
strShtname = Range(strRngName).Parent.Name

'clear any existing print areas and reset to named ranges areas
With Worksheets(strShtname)
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = Range(strRngName).Address
.PrintOut
' .PrintPreview
End With
Next i
End With

End Sub


Kindly assist.

Admin
10-15-2011, 06:15 PM
Hi,

Try this. untested.


Sub Print_Ranges()

Dim strShtname As String, strRngName As String
Dim i As Long, strFileName As String


With Worksheets("INDEX")

'sort the named range list according to page number order
.Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

'loop through the cells and determine parent of named range and specific range addresses
For i = 3 To 38
strRngName = .Cells(i, 2).Text
strShtname = Range(strRngName).Parent.Name
strFileName = ThisWorkbook.Path & "\" & strShtname & Format(Date, "mm-dd-yy") & ".pdf"
'clear any existing print areas and reset to named ranges areas
With Worksheets(strShtname)
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = Range(strRngName).Address
.PrintOut
' .PrintPreview

'// Save the print area as a PDF file
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Next i
End With

End Sub

excel_learner
10-15-2011, 11:06 PM
Thanks, I will test this..
Can this code be changed to do this saving in excel file. in fact all the ranges are in named sheet and i want to extract them in same named sheet and save them as flat file without formulas (for circulation) and leaving other sheets where named ranges are not taken in 1 to 38.

I would much appreciate that.

Thanks once again.

Admin
10-16-2011, 01:36 PM
Hi,

Again untested.


Sub Print_Ranges()

Dim strShtname As String, strRngName As String
Dim i As Long, strFileName As String
Dim wbkActive As Workbook
Dim wbkPDF As Workbook
Dim wbkNew As Workbook
Dim rngDest As Range
Dim RowsCount As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set wbkActive = ThisWorkbook
Set wbkPDF = Workbooks.Add
Set rngDest = wbkPDF.Worksheets(1).Range("a1")

With wbkActive.Worksheets("INDEX")

'sort the named range list according to page number order
.Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

'loop through the cells and determine parent of named range and specific range addresses
For i = 3 To 38
strRngName = .Cells(i, 2).Text
strShtname = Range(strRngName).Parent.Name

strFileName = wbkActive.Path & "\" & strShtname & Format(Date, "mm-dd-yy")
'clear any existing print areas and reset to named ranges areas
With wbkActive.Worksheets(strShtname)
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = Range(strRngName).Address

'// Paste the data to the workbook for PDF
.Range(strRngName).Copy rngDest
RowsCount = .Range(strRngName).Rows.Count
Set rngDest = rngDest.Offset(RowsCount)
'// Paste the data to a new workbook
Set wbkNew = Workbooks.Add
.Range(strRngName).Copy wbkNew.Worksheets(1).Range("a1")
'// Save the print area as a new file
wbkNew.SaveAs strFileName, 51
wbkNew.Close
Set wbkNew = Nothing
End With
Next i
End With

wbkPDF.Worksheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
wbkActive.Path & "\" & Format(Date, "mmmmyy") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False



End Sub

excel_learner
07-23-2015, 12:22 PM
Hi
Sorry for getting back very late on this...however, i am getting run time error "1004" on this line

.Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

Kindly advise.

Admin
07-24-2015, 08:06 AM
Try


.Range("A2").CurrentRegion.Sort key1:=.Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

excel_learner
08-12-2015, 01:21 PM
Hi, Thank you, however, it loops back to this
strShtname = .Range(strRngName).Parent.Name and stops there. But it does copy first page in the range and opens new wb and paste it there, but copies with formulas and not with correct page setup.

Please assist.

Admin
08-13-2015, 07:31 AM
Can you please attach the workbook ?

excel_learner
08-16-2015, 11:14 AM
Hi, Thanks, the file i have after cutting it short, is 1.4 mb, how do i attach it here as it allows only 102kb.

Admin
08-17-2015, 07:55 AM
Preserve the format and delete the data before uploading. Also delete unnecessary worksheets.

excel_learner
08-17-2015, 10:52 AM
Hi, the short report is attached.

Admin
08-20-2015, 07:40 AM
Hi


For i = 3 To 38
strRngName = .Cells(i, 2).Text
If Not ThisWorkbook.Name = ActiveWorkbook.Name Then ThisWorkbook.Activate
strShtname = Range(strRngName).Parent.Name
strFileName = wbkActive.Path & "\" & strShtname & Format(Date, "dd-mm-yy")
'clear any existing print areas and reset to named ranges areas
With wbkActive.Worksheets(strShtname)
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = .Range(strRngName).Address

'// Paste the data to the workbook for PDF
.Range(strRngName).Copy rngDest
RowsCount = .Range(strRngName).Rows.Count
Set rngDest = rngDest.Offset(RowsCount)
'// Paste the data to a new workbook
Set wbkNew = Workbooks.Add
.Range(strRngName).Copy wbkNew.Worksheets(1).Range("a1")
'// Save the print area as a new file
wbkNew.SaveAs strFileName, 51
wbkNew.Close
Set wbkNew = Nothing
End With
Next i

excel_learner
08-20-2015, 10:54 AM
Hi, thank you it worked, creates the pdf file but looses print areas and original columns' width and formatting, does not convert the ranges into a separate page. It also create an excel file but with same issue of print areas.

Admin
08-21-2015, 11:02 AM
code the copy paste part like this


.Range(strRngName).Copy
rngDest.PasteSpecial xlPasteValues
rngDest.PasteSpecial xlPasteFormats
rngDest.PasteSpecial xlPasteColumnWidths

excel_learner
08-26-2015, 04:51 PM
Thanks, however, in which place should i insert these codes.

Admin
08-27-2015, 07:29 AM
Sorry.

replace the following lines and paste the above code in procedure 'Print_Rangespdf'


'// Paste the data to the workbook for PDF
.Range(strRngName).Copy rngDest

excel_learner
08-27-2015, 11:13 AM
Hi, Admin, Thanks for the advice, however, see the attached file if i have correctly used the codes, as it has same formatting issue.

Please advise and thank you for your cooperation and patience.

Regards

excel_learner
09-03-2015, 12:25 PM
Dears

Any update on this.

Thank you

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://eileenslounge.com/viewtopic.php?p=316875#p316875 (https://eileenslounge.com/viewtopic.php?p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316254#p316254 (https://eileenslounge.com/viewtopic.php?p=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316046#p316046 (https://eileenslounge.com/viewtopic.php?p=316046#p316046)
https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050 (https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050)
https://www.youtube.com/@alanelston2330 (https://www.youtube.com/@alanelston2330)
https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z- (https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-)
https://eileenslounge.com/viewtopic.php?p=316154#p316154 (https://eileenslounge.com/viewtopic.php?p=316154#p316154)
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg (https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg)
https://teylyn.com/2017/03/21/dollarsigns/#comment-191 (https://teylyn.com/2017/03/21/dollarsigns/#comment-191)
https://eileenslounge.com/viewtopic.php?p=317050#p317050 (https://eileenslounge.com/viewtopic.php?p=317050#p317050)
https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854 (https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854)
https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875 (https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316057#p316057 (https://eileenslounge.com/viewtopic.php?p=316057#p316057)
https://eileenslounge.com/viewtopic.php?p=315915#p315915 (https://eileenslounge.com/viewtopic.php?p=315915#p315915)
https://eileenslounge.com/viewtopic.php?p=316705#p316705 (https://eileenslounge.com/viewtopic.php?p=316705#p316705)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=176255#p176255 (https://eileenslounge.com/viewtopic.php?p=176255#p176255)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

excel_learner
10-11-2015, 01:36 PM
Dears

Any updates on this...please.