我一直在创建报告，方法是将excel文档中的一些图表和数据复制到word文档中。我正在粘贴到内容控件中，所以我在excel中使用ChartObject.CopyPicture，在word中使用ContentControl.Range.Paste。这是在循环中完成的：
Set ws = ThisWorkbook.Worksheets("Charts")
With ws
For Each cc In wordDocument.ContentControls
If cc.Range.InlineShapes.Count > 0 Then
scaleHeight = cc.Range.InlineShapes(1).scaleHeight
scaleWidth = cc.Range.InlineShapes(1).scaleWidth
cc.Range.InlineShapes(1).Delete
.ChartObjects(cc.Tag).CopyPicture Appearance:=xlScreen, Format:=xlPicture
cc.Range.Paste
cc.Range.InlineShapes(1).scaleHeight = scaleHeight
cc.Range.InlineShapes(1).scaleWidth = scaleWidth
ElseIf ...
Next cc
End With
使用Office 2007创建这些报告产生的文件大约为6MB，但在Office 2010中创建它们（使用相同的工作表和文档）会产生大约10倍的文件。
解压缩docx后，我发现额外的大小来自emf文件，这些文件对应于使用VBA粘贴的图表。它们的范围从360到900 KB之间，它们是5-18 MB。而且图形效果并不明显。
更进一步，它似乎与图表风格有关。我创建了一个新的电子表格并插入了7个数据点和相应的2D饼图。使用默认样式，它复制为79 KB emf，而使用样式26复制为10 MB emf。当我使用Office 2007时，图表将复制为700 KB emf。这是代码：
Sub CopyAndPaste()
ThisWorkbook.Worksheets("Charts").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
GetObject(, Class:="Word.Application").ActiveDocument.Range.Paste
End Sub
我能够使用格式为xlBitmap的CopyPicture，虽然它稍微小一点，但它比Office 2007生成的emf大，而且质量明显较差。还有其他减少文件大小的选项吗？理想情况下，我想为使用Office 2007的图表生成一个具有相同分辨率的文件。有没有任何方法只使用VBA（不修改电子表格中的图表）？我可以轻易地复制为对象而无需链接文档吗？
答案 0 :(得分：1)
我在
之前处理过类似的事情而不是使用
Document.Range.Paste
尝试使用
Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture
或
Document.Range.PasteSpecial DataType:= wdPasteShape
这会将图表粘贴为图片或绘图，而不是嵌入的Excel对象
等同于使用菜单中的“选择性粘贴...”。
其他数据类型可用
http://msdn.microsoft.com/en-us/library/office/aa220339(v=office.11).aspx
答案 1 :(得分：1)
“这是一个较旧的代码，先生，但它检查出来。”
这是一个老问题，我有一个更老的（可能的）解决方案：你可以通过gzipping将.EMF文件压缩为.EMZ。这将在保持图像质量的同时减小文件大小。
在VB6上，我使用了zlib.dll和下面的代码。我将函数名称重命名为英语，但我用葡萄牙语保留所有评论：
Option Explicit
' Declaração das interfaces com a ZLIB
Private Declare Function gzopen Lib "zlib.dll" (ByVal file As String, ByVal mode As String) As Long
Private Declare Function gzwrite Lib "zlib.dll" (ByVal file As Long, ByRef uncompr As Byte, ByVal uncomprLen As Long) As Long
Private Declare Function gzclose Lib "zlib.dll" (ByVal file As Long) As Long
Private Declare Function Compress Lib "zlib.dll" Alias "compress" (ByRef dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long) As Long
Private Declare Function Uncompress Lib "zlib.dll" Alias "uncompress" (ByRef dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long) As Long
' Ler o conteúdo de um arquivo
Public Function FileRead(ByVal strNomeArquivo As String) As Byte()
Dim intHandle As Integer
Dim lngTamanho As Long
Dim bytConteudo() As Byte
On Error GoTo FileReadError
' Abrir o documento indicado
intHandle = FreeFile
Open strNomeArquivo For Binary Access Read As intHandle
' Obter o tamanho do arquivo
lngTamanho = LOF(intHandle)
ReDim bytConteudo(lngTamanho)
' Obter o conteúdo e liberar o arquivo
Get intHandle, , bytConteudo()
Close intHandle
FileRead = bytConteudo
On Error GoTo 0
Exit Function
FileReadError:
objLogger.GravarEvento "modZLib.FileRead: " & Err.Description & " (" & Err.Number & " - " & Err.Source & ")", logTipoEvento.Erro
End Function
'Compactar um arquivo com o padrão gzip
Public Sub FileCompress(ByVal strArquivoOrigem As String, ByVal strArquivoDestino As String)
Dim gzFile As Long
Dim bytConteudo() As Byte
On Error GoTo FileCompressError
' Ler o conteúdo do arquivo
bytConteudo = FileRead(strArquivoOrigem)
' Compactar o conteúdo
gzFile = gzopen(strArquivoDestino, "wb")
gzwrite gzFile, bytConteudo(0), UBound(bytConteudo)
gzclose gzFile
On Error GoTo 0
Exit Sub
FileCompressError:
objLogger.GravarEvento "modZLib.FileCompress:" & Err.Description & " (" & Err.Number & " - " & Err.Source & ")", logTipoEvento.Erro
End Sub
答案 2 :(得分：0)
可能会发生这种情况，因为.emf文件的缩放比例不正确。使用PNG可以解决大小问题（如上面的评论中所述），但仍然是一个问题，因为它们不是矢量图像。
如果您使用AddPicture将图像添加到文件中，则以下页面显示了一个解决方案，您可以在其中更改比例并从正在使用的默认值中减少文件大小。所以它可以解决你的问题。