我有两段独立工作的代码。
我想在我的床单上加一个按钮来同时做这两件事。换言之，使用ScreenShotResults4((生成的屏幕截图创建电子邮件，并附上PrintPIP_to_pdf((产生的pdf。
我试着组合，但出现语法错误。我在这样的网站的帮助下拼凑代码。
Public Sub ScreenShotResults4()
Dim rng As Range
Dim olApp As Object
Dim Email As Object
Dim Sht As Excel.Worksheet
Dim wdDoc As Word.Document
Set rng = Sheets("Summary").Range("B21:N37")
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set olApp = CreateObject("Outlook.Application")
Set Email = olApp.CreateItem(0)
Set wdDoc = Email.GetInspector.WordEditor
'strbody = "See production data for most recent 3 months. "
With Email
.To = Worksheets("Summary").Range("B21").Value
.Subject = "12 Month LO Production Lookback for " & Worksheets("Summary").Range("B21").Value & " (" & Worksheets("Summary").Range("B23").Value & "- " & Worksheets("Summary").Range("B35").Value & ")"
'.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
.Display
wdDoc.Range.PasteAndFormat Type:=wdChartPicture
'if need setup inlineshapes hight & width
With wdDoc.Content
'--- paste the range image first, because it overwrites
' everything in the document
.PasteAndFormat Type:=wdChartPicture
'--- now add our greeting at the start of the email
.InsertBefore "See 12 month production data. " & vbCr & vbCr
'--- finally add our sign off after the image
.InsertAfter vbCr & _
"Thank you" & vbCr & vbCr
End With
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set Email = Nothing
Set olApp = Nothing
End Sub
Sub PrintPIP_To_PDF()
Application.EnableEvents = True
ActiveSheet.Unprotect Password:="Mortgage1"
Dim PrintRng As Range
Dim pdfile As String
'Setting range to be printed
Set PrintRng = Worksheets("PIP").Range("B3:M27")
'Range("B25:C25").Font.Color = RGB(255, 255, 255)
sPath = Environ("USERPROFILE") & "Desktop"
pdfile = Application.GetSaveAsFilename _
(InitialFileName:=sPath & "PIP" & " " & Worksheets("Summary").Range("B21").Value, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
Filename = pdfile
If Filename = False Then
Exit Sub
Else
PrintRng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Call MsgBox(pdfile & " file has been saved!")
ActiveSheet.Protect Password:="Mortgage1"
End If
End Sub
请尝试一下。显示草稿电子邮件.Display之后使用.Attachment.Add "C:Test.pdf"
如果你愿意，你也可以使用.SaveAs "C:OutLookDraftsDraft1.msg"