Question

我一直在创建报告，方法是将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（不修改电子表格中的图表）？我可以轻易地复制为对象而无需链接文档吗？

Answer 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

Answer 2

“这是一个较旧的代码，先生，但它检查出来。”

这是一个老问题，我有一个更老的（可能的）解决方案：你可以通过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

Answer 3

可能会发生这种情况，因为.emf文件的缩放比例不正确。使用PNG可以解决大小问题（如上面的评论中所述），但仍然是一个问题，因为它们不是矢量图像。

如果您使用AddPicture将图像添加到文件中，则以下页面显示了一个解决方案，您可以在其中更改比例并从正在使用的默认值中减少文件大小。所以它可以解决你的问题。

http://social.msdn.microsoft.com/Forums/en-US/f1c9c753-77fd-4c17-9ca8-02908debca5d/emf-file-added-using-the-addpicture-method-looks-bigger-in-excel-20072010-vs-excel-2003?forum=exceldev

将从excel粘贴的图表的文件大小减小为word

3 个答案: