Vba Excel至PDF版本

因此，我有一个简单的小代码，可以通过Excel工作表上的命令按钮将Excel工作表转换为PDF：

Sub Save_Excel_As_PDF()

    ActiveSheet.ExportAsFixedFormat _
                  Type:=xlTypePDF

End Sub

问题是，我必须先手动完成这些步骤（另存为，然后是PDF等），以便在我首先完成手动步骤后按钮能够工作

---

我想把它保存在任何地方，只需点击按钮即可创建PDF文件，而无需先完成所有最初的手动步骤。是否可以修改此代码以实现此目的

我想这对我很有用：

Sub Macro1()

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

End Sub

---

如果不指定

FileName

参数，

PDF

将保存在

文档

文件夹中。在某个文件夹中执行手动

另存为
后，下次将在同一文件夹中创建

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

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

您可以指定此工作簿以外的其他名称或文件夹。路径
下面的脚本将所有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

将Excel子转换为PDF（）
将MyPath设置为字符串，将FileInPath设置为字符串
Dim MyFiles（）作为字符串，Fnum作为长度
将mybook设置为工作簿
暗淡的CalcMode与长
将sh设置为工作表
Dim ErrorYes作为布尔值
作为整数的Dim L位置
'填写Excel文件所在的路径\文件夹
MyPath=“c:\Users\yourpath\u here\”
FilesInPath=Dir（MyPath&“*.xl*”）
如果FilesInPath=“”，则
MsgBox“未找到任何文件”
出口接头
如果结束
Fnum=0
在文件输入路径“”时执行此操作
Fnum=Fnum+1
ReDim保留我的文件（1到Fnum）
MyFiles（Fnum）=FilesInPath
FilesInPath=Dir（）
环
应用
CalcMode=.Calculation
.Calculation=xlCalculationManual
.ScreenUpdate=False
.EnableEvents=False
以
如果Fnum>0，则
对于Fnum=LBound（MyFiles）到UBound（MyFiles）
设置mybook=Nothing
出错时继续下一步
设置mybook=Workbooks.Open（MyPath&MyFiles（Fnum））
错误转到0
如果不是的话，我的书什么都不是
LPosition=InStr（1，mybook.Name，“.”-1
mybookname=左侧（mybook.Name，LPosition）
我的书，激活
'所有PDF文件都保存在以下目录中：
ActiveSheet.ExportAsFixedFormat类型：=xlTypePDF，文件名：=
“C:\Users\your\u path\u here\”&mybookname&“.pdf”，
质量：=xlQualityStandard，IncludeDocProperties:=True，忽略打印区域_
：=错误，OpenAfterPublish:=错误
如果结束
mybook.Close SaveChanges:=False
下一个Fnum
如果结束
如果ErrorYes=True，则
MsgBox“一个或多个文件中存在问题，可能存在问题：”_
&vbNewLine&“受保护的工作簿/工作表或不存在的工作表/范围”
如果结束
应用
.ScreenUpdate=True
.EnableEvents=True
.Calculation=CalcMode
以
端接头
当我运行
ActiveSheet.ExportAsFixedFormat xlTypePDF
时，不会提示我手动执行任何操作。我不知道输出到哪里，但我没有得到任何错误或警告，也没有任何中断运行时的东西。你到底想干什么？太棒了！非常感谢。