从 Excel 复制到 Outlook - 图像左上角后面的白色单元格

Question

我正在将 Excel 内容从 Excel 复制到 Outlook 电子邮件正文，与许多其他用户不同，我的问题不是单元格格式混乱，而是当从 Excel 复制任何图像时，它们会被粘贴到 Outlook 中，并且图像左上角后面会出现一个白色单元格。

附加了示例图像，显示了它在 Excel 和 Outlook 中的显示效果。

我花了几个小时试图解决这个问题，包括：

• 更改图像格式 (PNG/JPG/BMP)
• 尝试各种分辨率、图像压缩、移动和随单元格调整大小选项等等。
• 尝试手动将范围复制到 Outlook 电子邮件正文中，VS 通过宏进行复制，将工作表范围转换为 HTML 字符串并直接从 Excel 生成电子邮件

最后一个选项，我使用 VBA 直接从 excel 生成电子邮件，它表现出的问题与从 excel 手动复制和粘贴完全相同。问题只发生在图像区域和图像左上角接触的单元格周围，无论这些单元格是常规单元格还是合并单元格。

这使我相信这要么是我的图像/对象的问题（我用形状替换了所有图像并遇到了同样的问题，要么是 MS Office 在处理带有对象的内容的复制和粘贴过程时出现了错误。

很想听听你们的意见，我已经筋疲力尽了。

谢谢你！

另外，这里是我用于将范围复制到 Outlook 的函数。

Excel VBA

Option Explicit

Private Function RngToEmail(rng As Range, eTo As String, eSubject As String)
    Dim wbThis As Workbook, wbNew As Workbook
    Dim tempFileName As String, imgName As String, newPath As String

    '~~> Do not change "Myimg". This will be used to
    '~~> identify the images
    Dim imgPrefix As String: imgPrefix = "Myimg"

    '~~> This is the temp html file name.
    '~~> Do not change this as when you publish the
    '~~> html file, it will create a folder Temp_files
    '~~> to store the images
    Dim tmpFile As String: tmpFile = "Temp.Htm"

    Set wbThis = Workbooks(rng.Parent.Parent.Name)
    Set wbNew = Workbooks.Add

    '~~> Copy the relevant range to new workbook
    rng.Copy wbNew.Worksheets("Sheet1").Range("A:A")

    newPath = wbThis.Path & "\"
    tempFileName = newPath & tmpFile

    '~~> Publish the image
    With wbNew.PublishObjects.Add(xlSourceRange, _
        tempFileName, "Sheet1", rng.Address, xlHtmlStatic, _
        imgPrefix, "")
        .Publish (True)
        .AutoRepublish = True
    End With

    '~~> Close the new file without saving
    wbNew.Close (False)

    '~~> Read the html file in a string in one go
    Dim MyData As String, strData() As String
    Dim i As Long
    Open tempFileName For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)

    '~~> Loop through the file
    For i = LBound(strData) To UBound(strData)
        '~~> Here we will first get the image names
        If InStr(1, strData(i), "Myimg_", vbTextCompare) And InStr(1, strData(i), ".Png", vbTextCompare) Then
            '~~> Insert actual path to the images
            strData(i) = Replace(strData(i), "Temp_files/", newPath & "Temp_files\")
        End If
    Next i

    '~~> Rejoin to get the new html string
    MyData = Join(strData, vbCrLf)

    '~~> Create the Email
    Dim OutApp As Object, OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .to = eTo
        .Subject = eSubject

        '~~> Set the body
        .HTMLBody = MyData

        '~~> Show the email. Change it to `.Send` to send it
        .Display
    End With

    '~~> Delete the temp file name
    Kill tempFileName
End Function

Sub Sample()
    RngToEmail ThisWorkbook.Sheets("FINAL").Range("A:F"), "[email protected]", "Some Subject"
End Sub

Answer 1

您是否在该单元格中插入了图片？我在 Outlook 2016 1812 版上测试时也发现了这个问题。粘贴到电子邮件正文时，图片后面的单元格会显示为空白或有线。我找不到相关的官方文章，而且我不熟悉 VBA 代码。

不过，我们可以在粘贴选项中选择以图片形式粘贴来避免这种情况。