在Excel中复制范围时，PasteSpecial不保留源格式

我正在将一系列单元格从现有工作簿复制到临时工作簿，并希望保留源工作簿的精确格式。 我正在使用Ron de Bruin的RangetoHTML函数的修改版本

目的是将一个范围从源工作簿复制到邮件正文

但是，当我运行宏时，它仅以不同格式的值粘贴邮件中的范围（请参见下面的链接）。PasteSpecial的所有其他粘贴类型要么失败，要么给出相同的结果

我试过每一种特殊的粘贴方法，但运气不好

如果我尝试为PasteSpecial函数指定更多参数，它会抛出一个1004错误（尽管我不需要使用默认值以外的任何东西）

源工作簿已合并单元格，但我尝试删除合并的单元格，但没有更改输出

当我要插入不同工作簿中的范围时，会多次调用此代码。结果总是正确的范围，但没有格式

它是从Access运行的，因为我正试图从窗体运行此脚本。它位于公共模块中，在另一个模块中创建邮件正文时调用。 以下是删除注释时出错部分的摘录：

Public Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006

    Dim xlApp As Excel.Application
    Dim TempWB As Excel.workbook

    Set TempWB = xlApp.Workbooks.Add(1)
    rng.Copy 'This is passed as an argument of the RangetoHTML function
    TempWB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues ', Operation:=-4142, SkipBlanks:=True, Transpose:=False
    TempWB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats ', Operation:=-4142, SkipBlanks:=True, Transpose:=False
    TempWB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ', Operation:=-4142, SkipBlanks:=True, Transpose:=False

'The rest is similar to the original version of RangetoHTML

    'Close TempWB
    TempWB.Close savechanges:=False
    xlApp.Quit

    Set TempWB = Nothing
    Set xlApp = Nothing

End Function

我希望邮件正文中显示的范围与源工作簿中显示的范围相同

我似乎找不到这段代码有任何问题，尽管我做了很多尝试，但它会阻止格式的复制

编辑：

如果我更改行：

Set TempWB = xlApp.Workbooks.Add(1)

致：

然后，输出的格式正确，但在子任务结束后，任务管理器中有一个Excel实例保持打开状态

编辑2:

下面是一些屏幕截图来帮助解释这个问题（敏感信息模糊）

这是我期望的输出：

下面是使用上面提供的代码时得到的实际结果：

我已经检查了粘贴表格的临时文件的内容，格式与粘贴在邮件正文中的内容相同。这告诉我这里的罪魁祸首是

PasteSpecial

，而不是RangetoHTML函数的其余部分

编辑3:

我还尝试使用普通的粘贴功能，得到了与上图相同的结果：

rng.Copy
TempWB.Worksheets(1).Paste

---

PasteSpecial

实际上，无论我提供的参数是什么，都不会执行任何操作。

如果要保留格式，需要使用

xlPasteAll

或

xlPasteAllUsingSourceTheme

值。请参阅。

您好，我使用您提供的链接中的列表尝试了所有粘贴类型

xlPasteAll

将范围复制为临时工作簿中的图片，邮件正文中不粘贴任何内容。当我使用

xlPasteAllUsingSourceTheme

时，我得到一个错误1004。尝试使用range.CopyPictureHi，我将代码更改为：

rng.CopyPicture TempWB.Worksheets（1）.ChartObjects.Add（0，0，rng.Width，rng.Height）。Chart.Paste

它以正确的格式复制了范围（与

TempWB.Worksheets（1.range（“A1”）的方式相同）.PasteSpecial Paste:=xlPasteAll

顺便说一句），但我相信Rangeto HTML函数不能管理图片，只能管理范围。因此，邮件正文中不会显示任何内容

TempWB.Close SaveChanges:=False

Good point。我就是这么做的，我还使用

xlApp.quit退出了Excel应用程序。但是，Excel应用程序仍在任务管理器中打开。
rng.Copy
TempWB.Worksheets(1).Paste