VBA将获取到的表格内容保存成PDF

dgseg

请教老师们一个问题，如何将现在自动识填充模版的表格内容保存成PDF格式，不要保存成Excel,现在保存的是eExcel，
代码也是借用论坛老师的改了一下，



Option Explicit

Sub text2()

Dim StarTime As Date
StarTime = Timer

'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
Application.EnableEvents = False  '//禁止触发其他事件
Application.StatusBar = True   '关闭系统状态

Dim x%, y%, i%, j%, H%
Dim Wk As Workbook, xWk As Workbook
Dim aSH As Worksheet, bSH As Worksheet, xSH As Worksheet

Set Wk = ThisWorkbook
Set aSH = Wk.Sheets("证明")
Set bSH = Wk.Sheets("模版")

Dim Arr, Brr, aRow%
aRow = aSH.Cells(9999, 1).End(xlUp).Row
Arr = aSH.Range("a1:x" & aRow).Value
Brr = bSH.Range("a1:i21").Value

   Dim xWkPath As String, xName As String
    xWkPath = Wk.Path
    If Right(xWkPath, 2) <> "\" Then xWkPath = xWkPath & "\"

For x = 3 To aRow

    Brr(3, 3) = Arr(x, 9)
    Brr(4, 1) = Arr(x, 2)
    Brr(4, 5) = Arr(x, 10)
    Brr(4, 7) = Arr(x, 4)
    Brr(6, 2) = Arr(x, 3)
    Brr(6, 5) = Arr(x, 11)
    Brr(7, 5) = Arr(x, 7)
    Brr(8, 3) = Arr(x, 8)
    Brr(8, 7) = Arr(x, 5)
    Brr(9, 2) = Arr(x, 6)
    Brr(9, 6) = Arr(x, 12)
   

' VBA获取当前时间,格式与系统时间格式相同。

    Dim CurrentDate
    CurrentDate = Date  '
    Cells(19, 7) = Date  'G19位置显示日期

    xName = xWkPath & Brr(2, 1) & Arr(x, 2)
    bSH.Copy
   
    ActiveWorkbook.SaveAs Filename:=xName
   Set xWk = ActiveWorkbook  '要复制内容为当前工作表
    Set xSH = xWk.Sheets("模版")
    xSH.Range("a1:i21") = Brr '保存的文件名为表1单元格里的内容
     xWk.Close Savechanges:=True  '保存并关闭工作簿

   
Next
         
Application.StatusBar = False   '//恢复系统状态条
Application.EnableEvents = True  '// 恢复触发其他事件
Application.ScreenUpdating = True '//恢复屏幕刷新
Application.DisplayAlerts = True '//恢复系统提示

MsgBox "共用" & Format(Timer - StarTime, "0.0000") & "秒，做了" & aRow - 3 & "份."

End Sub

aman1516

仅作参考：
Sub test()
ActiveSheet.Range("A1:E20").ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\MyPdf.pdf"
End Sub
单元格区域导出为PDF就一行代码，自己按需改下

dgseg

aman1516 发表于 2023-12-11 19:00
仅作参考：
Sub test()
ActiveSheet.Range("A1:E20").ExportAsFixedFormat xlTypePDF, ThisWorkbook.Pat ...

好的，感谢老师指导

dgseg

aman1516 发表于 2023-12-11 19:00
仅作参考：
Sub test()
ActiveSheet.Range("A1:E20").ExportAsFixedFormat xlTypePDF, ThisWorkbook.Pat ...

老师在请叫一下，怎么把生产的文件保存打桌面指定文件里

sero61

aman1516 发表于 2023-12-11 19:00
仅作参考：
Sub test()
ActiveSheet.Range("A1:E20").ExportAsFixedFormat xlTypePDF, ThisWorkbook.Pat ...

老师好，做了如下代码
Sub st()
Dim s$
s = ThisWorkbook.Path 'C:\Users\Administrator\Desktop
Sheet1.UsedRange.ExportAsFixedFormat xlTypePDF, s & "ddd.pdf"
End Sub
可是没有在桌面文件生成ddd.pdf文件是什么原因呢

ykcbf1100

sero61 发表于 2024-11-4 10:29
老师好，做了如下代码
Sub st()
Dim s$

建议上传附件，问题可以解决。

sero61

ykcbf1100 发表于 2024-11-5 10:13
建议上传附件，问题可以解决。

这个。。。感谢回复  随便一个表做练习的 没上传附件