如何复制带Excel SparkLines的区域粘贴到Outlook并避免模糊

方案1：直接复制带迷你图的区域（无需转图片） #

原始代码默认粘贴逻辑会自动匹配目标格式，丢失迷你图这类特殊单元格元素，手动粘贴时默认触发的「保留源格式」规则可以通过VBA指定粘贴参数实现，无需转图片即可完整保留迷你图：
修正后的完整代码：

Sub generatemail()
    ' 定义要复制的Excel区域
    Dim r As Range
    Set r = Range("A1:F71")
    r.Copy
    
    ' 初始化Outlook邮件
    Dim outlookApp As Outlook.Application
    Set outlookApp = CreateObject("Outlook.Application")
    Dim outMail As Outlook.MailItem
    Set outMail = outlookApp.CreateItem(olMailItem)
    outMail.Display
    
    ' 获取邮件的Word编辑器并指定粘贴格式
    Dim wordDoc As Word.Document
    Set wordDoc = outMail.GetInspector.WordEditor
    ' 粘贴参数：保留Excel源格式、带单元格样式、完整保留迷你图
    wordDoc.Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False
End Sub

注：使用前请先在VBA编辑器的「工具-引用」中勾选「Microsoft Outlook xx.x Object Library」和「Microsoft Word xx.x Object Library」；如果使用后期绑定，将对应常量替换为数值（olMailItem=0）即可无需提前引用。

该方案粘贴的内容为可编辑表格，迷你图显示效果和手动粘贴完全一致，无模糊问题。

方案2：高清图片粘贴方案 #

如果必须使用图片格式粘贴，不要用PasteAndFormat wdChartPicture方法转图片，而是在复制阶段就指定高清参数复制区域为矢量图：
替换原有复制+粘贴逻辑为以下代码：

' 复制区域为高清矢量图，Appearance参数用xlPrinter实现打印级分辨率
r.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
' 直接粘贴高清图片，无模糊
wordDoc.Range.Paste

该方法复制的是增强型图元格式矢量图，放大缩小都不会出现模糊问题，效果和手动粘贴的清晰度一致。

内容的提问来源于stack exchange，提问作者TourEiffel