Excel到PDF问题

所以我有这个简单的小代码来将Excel工作表转换为Excel工作表上的命令button上的PDF：

Sub Save_Excel_As_PDF() ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF End Sub 

问题是我必须先手动完成这些步骤（另存为，然后是PDF等），以便button在首先经过手动步骤之后工作。

我想保存在任何地方，只需点击button来创buildPDF，而无需先执行所有初始手动步骤。 这个代码可以修改来做到这一点？

Answer 1

没有指定FileName参数， PDF将被保存在您的Documents文件夹中。 在某个文件夹中执行手动Save As后，下次将在相同的文件夹中创build该文件。

您完全不需要这个function，您可以通过指定FileName参数，在与工作簿相同的文件夹中创build与工作表名称相同的FileName ：

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ FileName:=ThisWorkbook.Path & "\" & ActiveSheet.name 

您可以指定另一个名称或另一个文件夹ThisWorkbook.Path以外。

Answer 2

猜猜这对我有用：

 Sub Macro1() ChDir "C:\Users\Shyamsundar.Shankar\Desktop" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Shyamsundar.Shankar\Desktop\Sheet1.pdf", Quality:=xlQualityStandard End Sub 

Answer 3

下面的这个脚本将把所有的Excel文件转换成PDF文件。

 Sub Convert_Excel_To_PDF() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean Dim LPosition As Integer 'Fill in the path\folder where the Excel files are MyPath = "c:\Users\yourpath_here\" FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If Fnum = 0 Do While FilesInPath <> "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With If Fnum > 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then LPosition = InStr(1, mybook.Name, ".") - 1 mybookname = Left(mybook.Name, LPosition) mybook.Activate 'All PDF Files get saved in the directory below: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= "C:\Users\your_path_here\" & mybookname & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False End If mybook.Close SaveChanges:=False Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub