Excel工作表依次转换为PDF文件代码

Sub SelectFile()

On Error Resume Next

Application.ScreenUpdating = False

Dim FileName As Variant

Dim sFileName As String

Dim sPathName As String

Dim aFile As Variant

Dim fn, i%

Dim Sht As Worksheet

Dim WKbook As Workbook

FileName = Application.GetOpenFilename("Excel 文件(*.*),*.*", MultiSelect:=True)

For Each fn In FileName

Set WKbook = Workbooks.Open(fn)

For i = 1 To WKbook.Sheets.count

Set Sht = WKbook.Sheets(i)

Sht.Activate

With ActiveSheet.PageSetup

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.FitToPagesWide = 1

.FitToPagesTall = 1

.PrintErrors = xlPrintErrorsDisplayed

End With

Sht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=ActiveWorkbook.path + "¥" & VBA.Left(, Len() - 4)

& "" + "" & & "" + ".pdf", Quality:= _

xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True,

OpenAfterPublish:=False

Next i

WKbook.Close False

Next

Application.ScreenUpdating = True MsgBox "Done."

End Sub