目前我正在使用這段代碼，它不計算迷你圖：
Sub generatemail()
Dim r As Range
Set r = Range("A1:F71")
r.Copy
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
outMail.Display
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
wordDoc.Range.Paste
End Sub
我發現采用計數火花線的解決方法是將范圍的影像粘貼
wordDoc.Range.PasteAndFormat wdChartPicture
但它們是模糊的：
是否存在復制迷你圖的方法？(with Range.Copy) 如果不可能，我如何獲得更好的螢屏截圖而不模糊？
注意：當我這樣做時，SparkLine 不會模糊：
uj5u.com熱心網友回復：
關閉作業表中的網格線就能解決問題。（現在我對迷你圖沒有模糊了）
[如果有人知道如何將迷你圖從 excel 復制到 Outlook，請將其發布為答案。我會接受它，因為這是最好的方法]
uj5u.com熱心網友回復：
我通常創建一個圖片檔案，然后將其插入郵件中。這對我來說很好用，試試吧。
Option Explicit
Private PicFilename As String
Sub generatemail()
Dim r As Range: Set r = Range("A1:F71")
' Create picture
Call createPicture("xChart", r)
Dim outlookApp As Outlook.Application: Set outlookApp = CreateObject("Outlook.Application")
Dim OutMail As Outlook.MailItem: Set OutMail = outlookApp.CreateItem(olMailItem)
' Display mail
OutMail.Display
' Insert picture
Dim shp As Word.InlineShape
Dim wordDoc As Word.Document: Set wordDoc = OutMail.GetInspector.WordEditor
Set shp = wordDoc.Range.InlineShapes.AddPicture(PicFilename)
End Sub
Public Function createPicture(picName As String, picRng As Range) As Boolean
Dim PicTop, PicLeft, PicWidth, PicHeight As Long
Dim oChart As ChartObject
createPicture = False
PicFilename = ThisWorkbook.Path & "\" & picName & ".jpg"
On Error Resume Next
Kill PicFilename
ActiveSheet.ChartObjects(1).Delete
On Error GoTo 0
On Error GoTo ErrHandler
' Delete any existing picture
On Error Resume Next
If Dir(PicFilename) > 0 Then Kill (PicFilename)
On Error GoTo 0
' Create a bitmap image
On Error Resume Next
picRng.CopyPicture xlScreen, xlBitmap
On Error GoTo 0
' Create a new Temporary Chart
PicTop = picRng.Top
PicLeft = picRng.Left
PicWidth = picRng.Width
PicHeight = picRng.Height
Set oChart = ActiveSheet.ChartObjects.Add(Left:=PicLeft, Top:=PicTop, Width:=PicWidth, Height:=PicHeight)
With oChart
.Name = picName
.Activate
' Select chart area
.Chart.Parent.Select
' Paste the Picture in the chart area
.Chart.Paste
' Save chart as picture
.Chart.Export PicFilename
' Delete Picture
.Delete
createPicture = True
End With
exitRoutine:
Exit Function
ErrHandler:
Debug.Print Now() & ": " & Err.Description
Resume exitRoutine
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/313358.html