如何在VBA的HTML邮件正文中去除图片边框？

问题说明 #

用VBA把Excel指定区域导出成PNG图片，作为内嵌图片插入Outlook邮件时，图片周围多出一圈灰色边框。试过在HTML的<img>标签里加style='border:0'，但完全没用，想去掉这个多余的灰色边框。（注：Excel表格本身的蓝色边框是需要保留的，灰色边框为额外生成的）

可行的解决方法 #

1. 导出图片时去掉Chart的默认边框 #

你现在是把复制的区域粘贴到Chart里再导出，而Chart默认自带边框，这就是灰色边框的核心来源。修改createPNG子程序，在导出前把Chart的边框关掉：

With ThisWorkbook.Worksheets(Email_Pic).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
    .Activate
    ' 新增这行，移除Chart的边框
    .Chart.ChartArea.Border.LineStyle = xlNone
    .Chart.Paste
    .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
End With

2. 给HTML样式加优先级，覆盖Outlook默认样式 #

Outlook的HTML渲染有时候会忽略普通的行内样式，试试用!important强制生效，同时补充更多边框相关声明：

.HTMLBody = "<img src='cid:" & strTempFileName & ".png' style='border:0 !important; outline:none; border-width:0;'>"

3. 明确CopyPicture的参数，避免额外区域被复制 #

默认的CopyPicture可能会附带多余的区域，指定参数确保只复制你选中的范围：

' 替换原来的CopyPicture行，明确复制为屏幕样式的图片
rngToPicture.CopyPicture Appearance:=xlScreen, Format:=xlPicture

4. 检查Excel原区域的边框设置 #

确认你要导出的Excel区域（A1:P74）本身没有隐藏的边框或填充，有时候这些看不见的格式也会被导出到图片里。可以选中区域，在Excel的【开始】选项卡检查边框设置，确保只有需要的蓝色边框。

修改后的完整代码片段 #

主程序 #

Dim rngToPicture As Range
Dim outlookApp As Object
Dim Outmail As Object
Dim strTempFilePath As String
Dim strTempFileName As String
Dim strPDFPath As String

strPDFPath = "https://fcx365.sharepoint.com/Sites/STOTEC/ProjectFiles/Assignments/240925%20%2D%20Shift%20Report%20Refresh/" _
     & saveName & ".pdf"

strTempFileName = "RangeAsPNG"

Set rngToPicture = Worksheets("Email Template").Range("A1:P74")
Set outlookApp = CreateObject("Outlook.Application")
Set Outmail = outlookApp.CreateItem(olMailItem)

With Outmail
    .To = Join(Application.Transpose(Worksheets("Lists").Range("I2:I24")), ";")
    .Subject = "Shift Report"
        
    Call createPNG(rngToPicture, strTempFileName)
        
    strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
    .Attachments.Add strTempFilePath, olByValue, 0
    .Attachments.Add strPDFPath
    ' 增强样式声明
    .HTMLBody = "<img src='cid:" & strTempFileName & ".png' style='border:0 !important; outline:none; border-width:0;'>"
    .Display
    .Send
End With

Set Outmail = Nothing
Set outlookApp = Nothing
Set rngToPicture = Nothing

createPNG子程序 #

Sub createPNG(ByRef rngToPicture As Range, nameFile As String)
    Dim Email_Pic As String
    Email_Pic = rngToPicture.Parent.Name

    ' 删除同名旧文件
    On Error Resume Next
        Kill Environ$("temp") & "\" & nameFile & ".png"
    On Error GoTo 0

    ' 明确参数复制区域为图片
    rngToPicture.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    ' 创建Chart并移除边框
    With ThisWorkbook.Worksheets(Email_Pic).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
        .Activate
        .Chart.ChartArea.Border.LineStyle = xlNone ' 移除Chart边框
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
    End With
    Worksheets(Email_Pic).ChartObjects(Worksheets(Email_Pic).ChartObjects.Count).Delete
End Sub

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