VBA实用代码收藏

WORD批量转PDF（利用PDF虚拟打印机）

Sub 批量打印WORD文档()
     Dim fileToOpen, GetOpenFilename, App, iFile
     fileToOpen = Application.GetOpenFilename(filefilter:="Word文档(*.do*),*.do*", FilterIndex:=4, Title:="请选择要处理的文档(可多选)", MultiSelect:=True)
     If Not IsArray(fileToOpen) Then
         MsgBox "你没有选择文件", vbOKOnly, "提示": Exit Sub
     Else
         Set App = CreateObject("Word.Application")
         For Each iFile In fileToOpen
             Set WrdDoc = App.Documents.Open(iFile)
             App.Documents(WrdDoc).PrintOut
             App.Documents(WrdDoc).Close False
             T = T + 1
         Next
     End If
     MsgBox "操作完成！！" & vbCrLf & "打印了 " & T & " 个文件。", vbOKOnly, "提示"
End Sub

批量转换Excel工作簿为PDF

Sub BatchConvertWorkBookToPDF()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    Dim wkBook As Workbook
    Dim showFolder  As Boolean
    showFolder = False
    With fDialog
        .Filters.Add "Excel文件", "*.xls; *.xlsx; *.xlsm", 1
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                '如果选择了本工作簿则跳过
                If InStrRev(vrtSelectedItem, ThisWorkbook.Name) = 0 Then
                    On Error Resume Next
                    Set wkBook = Application.Workbooks.Open(vrtSelectedItem, ReadOnly:=True, Password:="")
                    '跳过设置打开密码的工作簿
                    If Not wkBook Is Nothing Then
                       '跳过隐藏的工作簿
                       If Windows(wkBook.Name).Visible = True Then
                       showFolder = True
                       '转换开始
                       wkBook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                          Left(vrtSelectedItem, InStrRev(vrtSelectedItem, ".") - 1) & ".pdf" _
                          , Quality:=xlQualityMinimum, IncludeDocProperties:=False, IgnorePrintAreas _
                          :=True, OpenAfterPublish:=False
                       wkBook.Close , savechanges = False
                       Else
                       wkBook.Close , savechanges = False
                       End If
                    End If
               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