将每个命名范围的PDF输出到单个页面-VBA

时间:2019-01-04 04:07:38

标签: excel vba pdf

我有一个excel模型,可以根据用户的输入动态更改范围的数目和名称。然后,将所有命名范围及其在相应单元格中的位置填充到参考选项卡上。我需要编写一个宏,该宏在单个页面上将每个命名范围的PDF都以PDF格式显示,但以单个PDF文件格式显示。

我尝试了所有可以找到各种显示PDF范围的方法的论坛,但没有任何方法可以凝聚地解决两个特定问题:

1)命名范围的数量将动态变化。我无法在我的VBA代码中静态命名它们。 2)命名范围在10个单独的工作表上。 3)有些表上有多个命名范围。它并不总是一对一的,这意味着我需要用它来打印同一工作表中的多个命名范围,但是结果仍然必须是每个PDF页面的一个命名范围。

有人可以帮我完成下面的列表,以实现我为每个命名范围创建一个带有单个页面的PDF文件的目标吗?作为参考,我的命名范围表如下所示:

Named Range, Location

Range1, =Sheet1!$K$2:$R$21
Range2, =Sheet2!$K$2:$R$21
Range3, =Sheet3!$K$2:$R$21
Range4, =Sheet4!$K$2:$R$21
Range5, =Sheet5!$K$2:$R$21
Range6, =Sheet6!$K$2:$R$21
Range7, =Sheet7!$K$2:$R$21
Range8, =Sheet8!$K$2:$R$21
Range9, =Sheet9!$K$2:$R$21
Range10, =Sheet10!$B$2:$I$21
Range10, =Sheet10!$K$2:$R$21 

在这个问题上我尝试了多种角度。我试图将所有命名范围移动到一个选项卡,但这非常困难,因为命名范围具有不同的格式,这意味着它不像复制和粘贴那样简单。 我不愿在这里显示任何代码,因为我尝试的20次迭代距离实现我的目标还很遥远。非常感谢有关结构上如何执行此操作的任何指导。

我希望最终的结果是一个宏,该宏可以从excel工作簿中PDF所有命名范围,并且每个命名范围在PDF文件中都有自己的页面。

2 个答案:

答案 0 :(得分:1)

如果将所需的每张纸上的打印区域设置为指定的范围,则应该能够使用以下方法每页输出所有所需的范围:

Save multiple sheets to .pdf

对于在一张纸上有多个范围的情况,如果将printarea设置为并集的总范围,则看起来每个区域都进入单独的页面,因此这不是什么大问题。

这是您如何做到的充实示例:

Sub PrintIt()

    Dim dict As Object, rngName As Range, wb As Workbook, nm As String
    Dim shtName As String, rng As Range, prevRange, k, first As Boolean
    Set dict = CreateObject("scripting.dictionary")

    Set wb = ThisWorkbook

    'Start by collecting all of the required ranges, organized by worksheet
    Set rngName = wb.Sheets("Reference").Range("A2") 'first range name
    Do While rngName <> ""
        nm = Trim(rngName.Value)
        Set rng = wb.Names(nm).RefersToRange   'get the range
        shtName = rng.Parent.Name              'sheet name for this range

        If Not dict.exists(shtName) Then   'new sheet?
            dict.Add shtName, rng          'create an entry for this sheet
        Else
            'add this range to the sheet's dictionary entry
            Set prevRange = dict(shtName)
            Set dict(shtName) = Application.Union(prevRange, rng)
        End If
        Set rngName = rngName.Offset(1, 0) 'next name
    Loop

    If dict.Count = 0 Then Exit Sub 'no names

    'set up the printing for each sheet
    first = True
    For Each k In dict.keys
        'set print area (can be multiple areas on one sheet)
        wb.Sheets(k).PageSetup.PrintArea = dict(k).Address
        'select for printing "first" controls whether sheet selection is cumulative
        wb.Sheets(k).Select first
        first = False '<< later sheets now get added to the already-selected sheet
    Next k

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

End Sub

答案 1 :(得分:0)

对@Tim Williams的想法应有的贡献,我只是提供基本的框架代码,作为可以根据要求进行修改的简单示例。

Sub test()
Dim Rng As Range
Dim Ws As Worksheet, Wb As Workbook
Dim Nm As Name
Set Wb = Application.Workbooks.Add

    For Each Nm In ThisWorkbook.Names
    Set Rng = Nm.RefersToRange
    Set Ws = Rng.Worksheet
    With Ws.PageSetup
        .PrintArea = Rng.Address
        ' may set other pagesetup properties according to requirement
    End With
    Ws.Copy After:=Wb.Sheets(Wb.Sheets.Count)
    Next Nm

Wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\user\Documents\Range to PDF.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
Wb.Close False
Set Wb = Nothing
End Sub