Excel в PDF, несколько диапазонов одного листа (строки), но ограничение строки PrintArea 255

Question

Я считаю, что диапазоны имеют ограничение в 255 символов, поэтому я разделил диапазоны на 6 ячеек От B1 до B6 (примеры ячеек B1 и B2 ниже значительно ниже 255 символов).

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

Я пытался использовать функцию Union для создания PDF из этих диапазонов, но каким-то образом я получаю диапазоны только из B1! B2 игнорируется. Вот мой код:

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

Answer 1

Может использовать этот обходной путь, чтобы обойти ограничение в 255 символов адреса диапазона области печати, добавляя горизонтальные разрывы страниц и скрывая строки между областями печати.Однако это применимо в этом случае, только если самые правые столбцы в каждой области печати одинаковы (т. Е. I), а также этот метод требует, чтобы каждая область печати была отделена хотя бы строкой.

Он успешно протестирован со строкой диапазона, как определено в OP.Сделайте некоторые изменения в отношении имени листов, диапазона и т. Д.

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

Снимок экрана созданного PDF

Answer 2

По какой-то причине код Ахмеда АС не сработал для меня на 100%, поэтому я немного его изменил. Вместо того, чтобы скрывать строки, которые я не использую, я показываю строки, которые я использую.

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

Answer 3

.PrintArea нужна строка вместо диапазона.Так что сейчас, он берет значение только из первой ячейки вашего диапазона, который является B1.Вам необходимо объединить сами значения и использовать объединенную строку в качестве значения для .PrintArea.

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