CODEWITHSUNDEEP
excelvba
tutu
tutu

Reputation: 695

Excel to PDF, multiple ranges same sheet (string) but PrintArea 255 string limit

I believe ranges have a 255 character limit, so I've split the ranges up in 6 cells B1 through B6 (cell B1 and cell B2 examples below both well below 255 characters).

A1:I15, A17:I40, A42:I65, A92:I114, A116:I140, A142:I168, A170:I196, A198:I224, A226:I252, A254:I280, A282:I308, A310:I336, A338:I364, A366:I392, A394:I420, A422:I448

A450:I476, A478:I504, A526:I552, A554:I580, A582:I608, A610:I636, A638:I664, A666:I690, A692:I707, A730:I750, A752:I773, A775:I794, A796:I815, A817:I830, A855:I877, A879:I905, A907:I926

I tried the Union function to generate a PDF from these ranges but somehow I am only getting the ranges from B1! B2 gets ignored. Here's my code:

Set rng = Union(shTemp.Range("B1"), shTemp.Range("B2"))

shTransformed.Activate
With ActiveSheet.PageSetup
    .Zoom = False
    .Orientation = xlPortrait
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .PrintArea = rng
 End With

 ActiveSheet.ExportAsFixedFormat _
 Type:=xlTypePDF, _
 Filename:="c:\temp\test.pdf", _
 Quality:=xlQualityStandard, _
 IgnorePrintAreas:=False, _
 IncludeDocProperties:=True, _
 OpenAfterPublish:=True

Upvotes: 1

Views: 239

Answers (3)

Ahmed AU
Ahmed AU

Reputation: 2777

May use this workaround to bypass 255 character limit of print area range address by adding Horizontal page breaks and hiding the rows in between print areas. However it is applicable in this case only as the right most column in each print areas are same (i.e. I) and also this method requires each print areas is to be separated by at least a row.

It is tested successfully with the range string as defined in OP. Make some modification regarding Sheets name, range etc.

Sub test()
Dim shTemp As Worksheet, shTr As Worksheet
Dim HideRng As Range, Rng As Range, MainRng As Range
Dim Ar As Range, cel As Range
Set shTemp = ThisWorkbook.Sheets(1)
Set shTr = ThisWorkbook.Sheets(2)

'To Dynamically Select Range containing Addresses
Dim SelRng As Range
Set SelRng = shTemp.Range("B1:B6")  ' Default range
shTemp.Activate
On Error Resume Next
Set SelRng = Application.InputBox("Select the range containing Print Range Addresses", "Select Range", SelRng.Address, , , , , 8)
    If Err > 0 Then
    Err.Clear
    Exit Sub
    End If
On Error GoTo 0
If SelRng Is Nothing Then Exit Sub

    For Each cel In SelRng.Cells
        If cel.Value <> "" Then
        If Not Range(cel.Value) Is Nothing Then
        'Debug.Print Range(cel.Value).Address
            If Rng Is Nothing Then
            Set Rng = Range(cel.Value)
            Else
            Set Rng = Union(Rng, Range(cel.Value))
            End If
        End If
        End If
    Next

If Rng Is Nothing Then Exit Sub

With shTr
 .Cells.PageBreak = xlPageBreakNone
pg = 1
maxcol = 1
    For Each Ar In Rng.Areas
        'Vartical Pagebreak: it is applicable only in this case where right column is same
        If pg = 1 Then
        Set MainRng = Ar(1, 1)
        .VPageBreaks.Add Ar(1, Ar.Columns.Count).Offset(0, 1)
        End If
    'Ar(1, 1).Value = "Page " & pg
    .HPageBreaks.Add Ar(Ar.Rows.Count, Ar.Columns.Count).Offset(1, 0)
        If pg > 1 Then
        If HideRng(HideRng.Rows.Count, 1).Row < Ar(1, 1).Row Then
        Set HideRng = Range(HideRng, Ar(1, 1).Offset(-1, 0))
        HideRng.EntireRow.Hidden = True
        End If
        End If
    Set HideRng = Ar(Ar.Rows.Count, 1).Offset(1, 0)
    If pg = Rng.Areas.Count Then Set MainRng = Range(MainRng, Ar(Ar.Rows.Count, Ar.Columns.Count))
    pg = pg + 1
    Next
End With

shTr.Activate
With ActiveSheet.PageSetup
    .Zoom = False
    .Orientation = xlPortrait
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .PrintArea = MainRng.Address
 End With

 ActiveSheet.ExportAsFixedFormat _
 Type:=xlTypePDF, _
 Filename:="c:\users\user\Desktop\test.pdf", _
 Quality:=xlQualityStandard, _
 IgnorePrintAreas:=False, _
 IncludeDocProperties:=True, _
 OpenAfterPublish:=True
End Sub

Screen Shot of created PDF

Upvotes: 2

tutu
tutu

Reputation: 695

For some reason Ahmed AU's code didn't work 100% for me so I changed it a little. Instead of hiding the rows I don't use I unhide the rows I use.

With shTransformed
    .Cells.PageBreak = xlPageBreakNone
    .Rows.EntireRow.Hidden = True

    .VPageBreaks.Add shTransformed.Range("J1")

    For Each Ar In Rng.Areas
        .Range(Ar.Address).EntireRow.Hidden = False
        .HPageBreaks.Add Ar(Ar.Rows.Count, Ar.Columns.Count).Offset(1, 0)
    Next Ar
End With

Set MainRng = shTransformed.Range("A" & shTransformed.Cells(1, 1).End(xlDown).Row - 1 & ":I" & shTransformed.Cells(shTransformed.Rows.Count, 1).End(xlUp).Row)

'Export to PDF code here

Upvotes: 1

Alex de Jong
Alex de Jong

Reputation: 1267

.PrintArea needs a string instead of a range. So right now, it only takes the value from the first cell of you range, which is B1. You need to concatenate the values themselves and use the concatenated string as value for .PrintArea.

https://learn.microsoft.com/en-us/office/vba/api/excel.pagesetup.printarea

Upvotes: 0

Related Questions