繁体   English   中英

Excel转PDF问题

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM