Pack all pages to a PDF files.

[KlausW]

Hi, I use this VBA code to package multiple sheets into a PDF file. This works as it should. The challenge lies in the sheet Bilag, which is on several pages. With this VBA code, it only packes some of the sheet's Bilag pages. And not the whole sheets. Some who can help.

Any help would be appreciated.

Best regards Klaus W

Sub Rektangelafrundedehjørner5_Klik()

 'Create and assign variables
Dim saveLocation As String
Dim sheetArray As Variant

saveLocation = Range("I3") & Sheets("Stamdata").Range("B1").Value & ".pdf"
sheetArray = Array("Rejsebeskrivelse", "Rapport", "Bilag")

'Select specific sheets from workbook, the save all as PDF
Sheets(sheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation
    
  Msgbox_BeforeRunning
     
  End Sub

 

[Anthony47]

Probably "Bilag" has a defined print area
If you need to print the whole worksheets then you have to remove the set PrintArea, and (better) restore it before ending the macro; for example:

Sub Rektangelafrundedehjørner5_Klik()

 'Create and assign variables
Dim saveLocation As String
Dim sheetArray As Variant
Dim CPArea()
'
saveLocation = Range("I3") & Sheets("Stamdata").Range("B1").Value & ".pdf"
sheetArray = Array("Rejsebeskrivelse", "Rapport", "Bilag")
'
ReDim CPArea(0 To UBound(sheetArray))
'Save and remove print area:
For I = 0 To UBound(sheetArray)
    CPArea(I) = Sheets(sheetArray(I)).PageSetup.PrintArea
    Sheets(sheetArray(I)).PageSetup.PrintArea = ""
Next I
'Select specific sheets from workbook, the save all as PDF
Sheets(sheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation
'Restore printarea:
For I = 0 To UBound(sheetArray)
    Sheets(sheetArray(I)).PageSetup.PrintArea = CPArea(I)
Next I
Sheets(sheetArray(0)).Select
  Msgbox_BeforeRunning
End Sub

 

[KlausW]

Probably "Bilag" has a defined print area
If you need to print the whole worksheets then you have to remove the set PrintArea, and (better) restore it before ending the macro; for example:

Sub Rektangelafrundedehjørner5_Klik()

 'Create and assign variables
Dim saveLocation As String
Dim sheetArray As Variant
Dim CPArea()
'
saveLocation = Range("I3") & Sheets("Stamdata").Range("B1").Value & ".pdf"
sheetArray = Array("Rejsebeskrivelse", "Rapport", "Bilag")
'
ReDim CPArea(0 To UBound(sheetArray))
'Save and remove print area:
For I = 0 To UBound(sheetArray)
    CPArea(I) = Sheets(sheetArray(I)).PageSetup.PrintArea
    Sheets(sheetArray(I)).PageSetup.PrintArea = ""
Next I
'Select specific sheets from workbook, the save all as PDF
Sheets(sheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation
'Restore printarea:
For I = 0 To UBound(sheetArray)
    Sheets(sheetArray(I)).PageSetup.PrintArea = CPArea(I)
Next I
Sheets(sheetArray(0)).Select
  Msgbox_BeforeRunning
End Sub

I'm sorry to say, but it doesn't work. It takes many pages. Sheets "Rejsebeskrivelse", "Rapport”

is only 1 page each. It's just Sheets class=prism-token>"Bilag" which take several pages, never the same number. Can it be made so that from a single cell you can create Excel pages in Sheets "Bilag".

 

[Anthony47]

Does sheet "Bilag" have a "PrintArea"? remove it manually (Menu /Page Layout; group Page setting) and try your original macro. Does it work as expected?

 

[KlausW]

No it still make allot of empty pages.

 

[Anthony47]

Hi, I use this VBA code to package multiple sheets into a PDF file. This works as it should. The challenge lies in the sheet Bilag, which is on several pages. With this VBA code, it only packes some of the sheet's Bilag pages. And not the whole sheets. Some who can help.

By this initial statement I understood that "Bilag" is a long sheet but only a portion of it was saved in the pdf

So, when you say "No it still make allot of empty pages" what do you mean? Did you use your original macro for this last test? Which was the step of your test?

 

[KlausW]

By this initial statement I understood that "Bilag" is a long sheet but only a portion of it was saved in the pdf

So, when you say "No it still make allot of empty pages" what do you mean? Did you use your original macro for this last test? Which was the step of your test?

If I change remove it manually (Menu /Page Layout; group Page setting) and try my original macro. There are a lot of empty pages.

 

[Anthony47]

Probably your "Bilag" has corrupted UsedRange, or has random formats here and there that convert empty areas to used ones

This is my penultimate proposal, ie find the boundary of the available data and set PrintArea according to that information; this limited to "Bilag"
The code:

Sub Rektangelafrundedehjørner5_Klik()
 'Create and assign variables
Dim saveLocation As String
Dim sheetArray As Variant
Dim CPArea, ManPArea, LastR As Long, LastC As Long
'
saveLocation = Range("I3") & Sheets("Stamdata").Range("B1").Value & ".pdf"
sheetArray = Array("Rejsebeskrivelse", "Rapport", "Bilag")
ManPArea = "Bilag"
'
'Save and reset print area:
Sheets(ManPArea).Select
CPArea = Sheets(ManPArea).PageSetup.PrintArea
LastR = Range("A:AZ").Find(What:="*", After:=Range("A1"), _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
LastC = Range("1:1000").Find(What:="*", After:=Range("A1"), _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column
Sheets(ManPArea).PageSetup.PrintArea = Range("A1").Resize(LastR, LastC).Address
'
'Select specific sheets from workbook, the save all as PDF
Sheets(sheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation
'Restore printarea:
Sheets(ManPArea).PageSetup.PrintArea = CPArea
Sheets(sheetArray(0)).Select
  Msgbox_BeforeRunning
   
End Sub

This limits the search to columns A:AZ and Rows 1:1000
Try...

 

[KlausW]

Hi Anthony 47 thanks a lot just as it should be. Great. Thanks for the big help. Best Regards Klaus W

​