|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54 |
Sub BatchConvertToPDF() Dim
destFolderPath As
String destFolderPath = GetFolderPath If
destFolderPath <> Empty Then Dim
path As
Variant For
Each path In
GetFilePaths() Dim
indexOfSlash, indexOfDot As
Integer indexOfSlash = InStrRev(path, "\") indexOfDot = InStrRev(path, ".") Dim
destFilePath As
String destFilePath = destFolderPath + Mid(path, indexOfSlash, indexOfDot - indexOfSlash) + ".pdf" ConvertToPDF path, destFilePath Next
path End
IfEnd SubFunction
GetFilePaths() Dim
folderPath As
String With
Application.FileDialog(msoFileDialogFilePicker) .Filters.Add "word文件", "*.doc; *.dotx; *.docm" .Title = "请择要转换的word文件" If
.Show = -1 Then Set
GetFilePaths = .SelectedItems End
If End
WithEnd FunctionFunction
GetFolderPath() Dim
folderPath As
String With
Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Title = "请选择要存放的目录" If
.Show = -1 Then GetFolderPath = .SelectedItems(1) End
If End
WithEnd FunctionSub ConvertToPDF(srcPath As
Variant, destPath As
String) Documents.Open FileName:=srcPath, ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" ActiveDocument.ExportAsFixedFormat OutputFileName:= _ destPath, ExportFormat:= _ wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _ wdExportOptimizeForOnScreen, Range:=wdExportAllDocument, From:=1, To:=1, _ Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False ActiveDocument.CloseEnd Sub |
使用VBA将批量的WORD文档转换为PDF,布布扣,bubuko.com
原文：http://www.cnblogs.com/beta2013/p/3666077.html