使用 VBA 打印到 PDF 现有宏

Question

所以我在网上找到了这段代码，并且能够对其进行编辑以执行我想要的操作，除了保存为 PDF 之外，它当前设置为仅显示打印预览。有人可以解释如何编辑它以保存为 PDF，文件名最终出现在单元格“A2”中

Sub testme()

Dim TempWks As Worksheet
Dim wks As Worksheet

Dim myRng As Range
Dim myCell As Range

'change to match your worksheet name
Set wks = Worksheets("Sheet3")
Set TempWks = Worksheets.Add

wks.AutoFilterMode = False 'remove the arrows

'assumes headers only in row 1
wks.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=TempWks.Range("A1"), Unique:=True

With TempWks
    Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With wks
    For Each myCell In myRng.Cells
        .UsedRange.AutoFilter Field:=1, Criteria1:=myCell.Value
        Dim MyFileName As Variant
Dim MyfilePath As Variant
Dim rng As Range
Set wks = Worksheets("Sheet3")
Set rng = wks.Cells(2, 1)

MyfilePath = "C:\Users\mmunoz\Desktop\Teresa" 'this is whatever location you wish to save in

MyFileName = MyfilePath & "\" & rng.Value & ".pdf" 'You can do the below in just a couple of lines, but this is way more effective and stops issues later on

    ChDir _
    MyfilePath ' hold your save location


wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    MyFileName, Quality:= _
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False 'did you want to open the file after saving?
    Next myCell
End With

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

结束子

我有一堆数据需要过滤以仅显示客户的数据行并将其保存为 PDF 以发送给客户。

谢谢，

Answer 1

这是您想要的要点。我加了cmets来解释

Dim MyFileName As Variant
Dim MyfilePath As Variant
Dim rng As Range

Set rng = wks.Cells(2, 1)

MyfilePath = "N:\Desktop" 'this is whatever location you wish to save in

MyFileName = MyfilePath & "\" & rng.Value & ".pdf" 'You can do the below in just a couple of lines, but this is way more effective and stops issues later on

    ChDir _
    MyfilePath ' hold your save location


 wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   MyFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True 'did you want to open the file after saving?

Answer 2

选项显式 子testme()

Dim TempWks As Worksheet
Dim wks As Worksheet

Dim myRng As Range
Dim myCell As Range

'change to match your worksheet name
Set wks = Worksheets("Sheet3")

Set TempWks = Worksheets.Add

wks.AutoFilterMode = False 'remove the arrows

'assumes headers only in row 1
wks.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=TempWks.Range("A1"), Unique:=True

With TempWks
    Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With wks
    For Each myCell In myRng.Cells
        .UsedRange.AutoFilter Field:=1, Criteria1:=myCell.Value
Dim MyFileName As Variant
Dim MyfilePath As Variant
Dim rng As Range

Set rng = wks.Cells(2, 1)

MyfilePath = "C:\Users\mmunoz\Desktop\Teresa" 'File Location

MyFileName = MyfilePath & "\" & myCell.Value & ".pdf" 'File Name

    ChDir _
    MyfilePath


wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  MyFileName, Quality:= _
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
  OpenAfterPublish:=False
    Next myCell
End With

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

结束子