Sub 宏1() Application.DisplayAlerts = False Application.ScreenUpdating = False
Dim fDialog As FileDialog Set fDialog = Application.FileDialog(msoFileDialogFilePicker) Dim vrtSelectedItem As Variant Dim wdDoc As Document Dim showFolder As Boolean showFolder = False With fDialog .Filters.Add "Word文件", ".doc;.docx;*.docm", 1 If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems '如果选择了本文档则跳过 If InStrRev(vrtSelectedItem, ThisDocument.Name) = 0 Then On Error Resume Next Set wdDoc = Application.Documents.Open(vrtSelectedItem, ReadOnly:=True) wdDoc.SaveAs Left(vrtSelectedItem, Len(vrtSelectedItem) - 4), wdFormatPDF wdDoc.Close False
End If Next vrtSelectedItem If showFolder Then Call Shell("explorer.exe " & Left(fDialog.SelectedItems(1), _ InStrRev(fDialog.SelectedItems(1), "")), vbMaximizedFocus) End If End With
Set fDialog = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
