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
