|
'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
|
|