如何保存所有Excel图表在一个PDF然后通过电子邮件发送

我将不胜感激,如果你能帮助我,我正在创build一个dynamic的Excel表,我pipe理到目前为止使用Excel vba VBA创buildExcel图表。

然而,我正在努力出口所有的图表和一个附加的表格到一个pdf 。 我有大约15个Excel图表和一个Excel表格,我需要把一个pdf 。 我需要把Excel表格作为pdf的第一页。 然后通过电子邮件发送这个pdf (全部使用vba)。

你能帮我解决这个问题吗? 非常感谢您的帮助。 先谢谢你!

那么你可以发布工作簿为PDF,只要确保你的拳头页面是第一张

 Option Explicit Sub PDF_And_Mail() Dim FileName As String '// Call the function with the correct arguments FileName = Create_PDF(Source:=ActiveWorkbook, _ OverwriteIfFileExist:=True, _ OpenPDFAfterPublish:=False) If FileName <> "" Then Mail_PDF FileNamePDF:=FileName End If End Sub '// Create PDF Function Create_PDF(Source As Object, OverwriteIfFileExist As Boolean, _ OpenPDFAfterPublish As Boolean) As String Dim FileFormatstr As String Dim Fname As Variant '// Test If the Microsoft Add-in is installed If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _ & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then '// Open the GetSaveAsFilename dialog to enter a file name for the pdf FileFormatstr = "PDF Files (*.pdf), *.pdf" Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _ Title:="Create PDF") '// If you cancel this dialog Exit the function If Fname = False Then Exit Function End If 'If OverwriteIfFileExist = False we test if the PDF 'already exist in the folder and Exit the function if that is True If OverwriteIfFileExist = False Then If Dir(Fname) <> "" Then Exit Function End If 'Now the file name is correct we Publish to PDF Source.ExportAsFixedFormat _ Type:=xlTypePDF, _ FileName:=Fname, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=OpenPDFAfterPublish 'If Publish is Ok the function will return the file name If Dir(Fname) <> "" Then Create_PDF = Fname End If End If End Function '// Email Created PDF Function Mail_PDF(FileNamePDF As String) Dim GMsg As Object Dim gConf As Object Dim GmBody As String Dim Flds As Variant Set GMsg = CreateObject("CDO.Message") Set gConf = CreateObject("CDO.Configuration") gConf.Load -1 ' CDO Source Defaults Set Flds = gConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "GmailAddress@gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With GmBody = "Hi there" & vbNewLine & vbNewLine With GMsg Set .Configuration = gConf .To = "recip@email.com" .CC = "" .BCC = "" .From = "Reply@something.com" .Subject = "Important message" .TextBody = GmBody .AddAttachment FileNamePDF .Send End With End Function 

大多数代码来自 Ron de Bruin