将活动的打开文档另存为pdf文件

时间:2015-09-19 04:29:36

标签: excel vba excel-vba pdf word-vba

我有以下代码从excel复制范围单元格值并粘贴为新word文档中的图片。 我想将活动文档保存为pdf文件,文件名为cell" A2"中的值。 如果你可以帮助我在下面的代码中添加相同内容,那将是一个很好的帮助。

Sub Picture()
Dim objWord, objDoc As Object
ActiveWindow.View = xlNormalView
Range("A2:K25").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
objWord.Selection.Paste
objWord.Selection.TypeParagraph

End Sub

1 个答案:

答案 0 :(得分:0)

试试这个,

Sub SaveAsPDF()
    Dim objWord, objDoc As Object
    Dim A2 As String
    Dim Crng As Range

    A2 = Range("A2")
    Set Crng = Range("A2:K25")

    Crng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = True
    objWord.Selection.Paste
    objWord.Selection.TypeParagraph

    With objDoc
        .ExportAsFixedFormat OutputFileName:= _
                             "C:\Users\Dave\Downloads\" & A2 & ".pdf", ExportFormat:=17, _
                             OpenAfterExport:=True, OptimizeFor:=0, Range:= _
                             0, From:=1, To:=1, Item:=0, _
                             IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
                             0, DocStructureTags:=True, BitmapMissingFonts:= _
                             True, UseISO19005_1:=False
        .Close saveChanges:=False
    End With
    objWord.Quit
    Set objWord = Nothing

End Sub

而不是使用Word到PDF使用excel

Sub SaveAsPDFxlStyle()
    Dim objWord, objDoc As Object
    Dim A2 As String

    A2 = Range("A2")
    ActiveSheet.PageSetup.PrintArea = "$A$2:$K$25"

    With ActiveSheet.PageSetup
        .PrintGridlines = True
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                    "C:\Users\Dave\Downloads\" & A2 & ".pdf", Quality:= _
                                    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=0

End Sub