[英]Excel To PDF issue
因此,我有以下简单的小代码可以在Excel工作表上的命令按钮上将Excel工作表转换为PDF:
Sub Save_Excel_As_PDF()
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF
End Sub
问题是我必须先手动执行步骤(另存为,然后是PDF等),才能使按钮在我首先执行手动步骤后起作用。
我想将其保存在任何地方,只需单击按钮即可创建PDF,而无需先完成所有初始手动步骤。 可以修改此代码来做到这一点吗?
如果不指定FileName
参数,则PDF
将保存在“ Documents
文件夹中。 在某个文件夹中手动执行“ Save As
后,下一次将在同一文件夹中创建该文件。
您根本不需要它,您可以通过指定FileName
参数在与工作簿相同的文件夹中创建文件,并与工作表名称相同。
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=ThisWorkbook.Path & "\" & ActiveSheet.name
您可以指定除ThisWorkbook.Path
之外的其他名称或文件夹。
猜猜这对我有用:
Sub Macro1()
ChDir "C:\Users\Shyamsundar.Shankar\Desktop"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Shyamsundar.Shankar\Desktop\Sheet1.pdf", Quality:=xlQualityStandard
End Sub
下面的脚本将所有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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.