将Excel范围作为图片复制到Outlook [英] Copy Excel range as Picture to Outlook
本文介绍了将Excel范围作为图片复制到Outlook的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
如何使用您从右键菜单中在Excel中访问的命令特殊粘贴-图片形式"?
How can I use the command "Paste Special - As Picture" that you access in Excel from the right-click menu?
我已经查看了各种帖子,但是使用Excel 2016时它们似乎已经过时了.似乎必须在本节中,
I have viewed various posts, but they seem to be outdated when using Excel 2016. It seems it has to be in this section,
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
如何更改以允许复制和粘贴为图片?
How do I alter to allow copy and paste as picture?
使用下面的原始代码时,我失去了电子邮件正文中的所有列和行大小.
When using the original code below, I lose all column and row sizing in the email body.
Dim rng As Range
Dim OutApp As Object
Dim outMail As Object
Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = Sheets("Dashboard").Range("B4:L17").SpecialCells(xlCellTypeVisible)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set outMail = OutApp.CreateItem(0)
With outMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = RangetoHTML(rng)
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set outMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' By Ron de Bruin.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
推荐答案
要在Outlook上获得更好的图片,请使用 示例
Option Explicit
Public Sub Example()
Dim rng As Range
Dim olApp As Object
Dim Email As Object
Dim Sht As Excel.Worksheet
Dim wdDoc As Word.Document
Set Sht = ActiveWorkbook.Sheets("Dashboard")
Set rng = Sht.Range("B4:L17")
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
With Email
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Attachments.Add ActiveWorkbook.FullName
wdDoc.Range.PasteAndFormat Type:=wdChartPicture
' if need setup inlineshapes hight & width
With wdDoc
.InlineShapes(1).Height = 130
End With
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set Email = Nothing
Set olApp = Nothing
End Sub
这篇关于将Excel范围作为图片复制到Outlook的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文