ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 772|回复: 0

excel批量转pdf

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-12-4 21:33 | 显示全部楼层 |阅读模式
'xlsx转pdf
Option Explicit
Sub xlsxConverter()
On Error Resume Next
Dim sEveryFile As String, sSourcePath As String, sNewSavePath As String
Dim CurXls As Object
sSourcePath = "E:\XLSX文件\"
'假定待转换的xlsx文件全部在"E:\XLSX文件\"下,你需要按实际情况修改。
sEveryFile = Dir(sSourcePath & "*.xlsx")
Do While sEveryFile <> ""
   Set CurXls = Workbooks.Open(sSourcePath & sEveryFile, , msoTrue)
   sNewSavePath = VBA.Strings.Replace(sSourcePath & sEveryFile, ".xlsx", ".pdf")
   '转化后的文件也在"E:\xlsx文件\"下,当然你可以按需修改。
   CurXls.ExportAsFixedFormat xlTypePDF, sNewSavePath
   '更多格式可参见文末的截图ExportAsFixedFormat
   CurXls.Close SaveChanges:=False
   sEveryFile = Dir
Loop
Set CurXls = Nothing
End Sub

'xlsx转xls、csv
Option Explicit
Sub xlsxConverter()
On Error Resume Next
Dim sEveryFile As String, sSourcePath As String, sNewSavePath As String
Dim CurXls As Object
sSourcePath = "E:\XLSX文件\"
'假定待转换的xlsx文件全部在"E:\XLSX文件\"下,你需要按实际情况修改。
sEveryFile = Dir(sSourcePath & "*.xlsx")
Do While sEveryFile <> ""
   Set CurXls = Workbooks.Open(sSourcePath & sEveryFile, , msoTrue)
   sNewSavePath = VBA.Strings.Replace(sSourcePath & sEveryFile, ".xlsx", ".xls")
   '如果想导出csv,就把第12行行尾的xls换成csv
   '如果想把xls转为xlsx,把第9行的xlsx改为xls,把第12行行尾的".xlsx", ".xls"改为".xls", ".xlsx"
   '转化后的文件也在"E:\xlsx文件\"下,当然你可以按需修改。
   CurXls.SaveAs sNewSavePath, xlExcel8
   'xls对应xlExcel8,csv对应xlCSV,xlsx对应xlWorkbookDefault
   '更多格式可参见文末的截图XlFileFormat Enumeration (Excel)
   CurXls.Close SaveChanges:=False
   sEveryFile = Dir
Loop
Set CurXls = Nothing
End Sub



'docx转pdf、doc、rtf、txt
Option Explicit
Sub docx2other()
On Error Resume Next
Dim sEveryFile As String, sSourcePath As String, sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\DOCX文件\"
'假定待转换的docx文件全部在"E:\DOCX文件\"下,你需要按实际情况修改。
sEveryFile = Dir(sSourcePath & "*.docx")
Do While sEveryFile <> ""
   Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
   sNewSavePath = VBA.Strings.Replace(sSourcePath & sEveryFile, ".docx", ".pdf")
   '如果想导出doc/rtf/txt等,就把上一行行尾的pdf换成doc/rtf/txt
   '转化后的文件也在"E:\DOCX文件\"下,当然你可以按需修改。
   CurDoc.SaveAs2 sNewSavePath, wdFormatPDF
   'pdf对应wdFormatPDF,doc对应wdFormatDocument,rtf对应wdFormatRTF,txt对应wdFormatText
   '更多格式可参见文末的截图WdSaveFormat Enumeration
   CurDoc.Close SaveChanges:=False
   sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub



'pdf、doc、rtf、txt转docx
Option Explicit
Sub other2docx()
On Error Resume Next
Dim sEveryFile As String, sSourcePath As String, sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\PDF文件\"
'假定待转换的pdf文件全部在"E:\PDF文件\"下,你需要按实际情况修改。
sEveryFile = Dir(sSourcePath & "*.pdf")
Do While sEveryFile <> ""
   Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
   CurDoc.Convert
   sNewSavePath = VBA.Strings.Replace(sSourcePath & sEveryFile, ".pdf", ".docx")
   '要把doc/rtf/txt转为docx,则把上面第9行和第13行两处".pdf"改为".doc"/".rtf"/".txt"
   '转化后的文件也在"E:\PDF文件\"下,当然你可以按需修改。
   CurDoc.SaveAs2 sNewSavePath, wdFormatDocumentDefault
   CurDoc.Close SaveChanges:=False
   sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub



'pptx转pdf、ppt
Option Explicit
Sub pptxConverter()
On Error Resume Next
Dim sEveryFile As String, sSourcePath As String, sNewSavePath As String
Dim CurPpt As Object
sSourcePath = "E:\PPTX文件\"
'假定待转换的pptx文件全部在"E:\PPTX文件\"下,你需要按实际情况修改。
sEveryFile = Dir(sSourcePath & "*.pptx")
Do While sEveryFile <> ""
   Set CurPpt = Presentations.Open(sSourcePath & sEveryFile, msoTrue, , msoFalse)
   sNewSavePath = VBA.Strings.Replace(sSourcePath & sEveryFile, ".pptx", ".pdf")
   '如果想导出ppt,就把第12行行尾的pdf换成ppt
   '如果想把ppt转为pptx,把第9行的pptx改为ppt,把第12行行尾的 ".pptx", ".pdf"改为 ".ppt", ".pptx"
   '转化后的文件也在"E:\PPTX文件\"下,当然你可以按需修改。
   CurPpt.SaveAs sNewSavePath, ppSaveAsPDF
   'pdf对应ppSaveAsPDF,ppt对应ppSaveAsPresentation,pptx对应ppSaveAsDefault
   '更多格式可参见文末的截图PpSaveAsFileType
   CurPpt.Close SaveChanges:=False
   sEveryFile = Dir
Loop
Set CurPpt = Nothing
End Sub



Excel转成pdf.zip

15.8 KB, 下载次数: 38

exceltrianpdf

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 23:35 , Processed in 0.030589 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表