减少从excel粘贴到word图表的文件大小

我一直在通过将excel文档中的一些图表和数据复制到word文档来创建报表。我粘贴到内容控件中，所以我在excel中使用ChartObject.CopyPicture，在word中使用ContentControl.Range.Paste。这是在一个循环中完成：减少从excel粘贴到word图表的文件大小

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后，我发现额外的大小来自与使用VBA粘贴的图表对应的emf文件。它们的范围从360到900 KB之间，它们是5-18 MB。而图形并不明显更好。

更进一步，它似乎与图表样式有关。我创建了一个新的电子表格并插入了7个数据点和一个相应的2D饼图。使用默认样式，它将复制为79 KB emf，并使用样式26复制为10 MB emf。当我使用Office 2007时，图表会复制为700 KB电动势。这是代码：

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和明显的质量比较差所产生的电动势较大。是否有其他选择来减小文件大小？理想情况下，我希望为图表生成一个与我使用Office 2007时相同分辨率的文件。有什么方法只使用VBA（不需要修改电子表格中的图表）？任何方式，我可以很容易地复制为一个对象，而无需链接文档？

来源

2014-05-22 Steve Clanton

有一些改变，在Excel 2010图表：看到这个博客]（HTTP ：//blogs.office.com/2009/08/25/more-charting-enhancements-in-excel-2010/），尽管没有一个突出显示为o明显的原因。你是否使用'CopyPicture Appearance：= xlPrinter'，因为这比'xlScreen'提供更大的文件？否则，你能给出一些关于图表的更多细节（什么类型，什么样的格式，多少个数据点）？ – aucuparia

如何以更高效的格式导出图表（类似于'ActiveChart.Export“C：\ My Charts \ SpecialChart.png''），然后将.png导入到Word中？应该是一个可管理的文件大小。 –

你可以添加你使用的实际代码吗？粘贴时是否包含数据链接？ – Adach1979

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

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

来源

2015-04-24 18:51:43

尽管我希望有更好的东西，但这比我找到的其他东西更好。我认为这是可以做到的最好的。谢谢。 –

这可能是因为.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

来源

2014-07-01 23:02:56 hnk

我已经经历了这样的事情之前

而不是使用

Document.Range.Paste

尝试使用

Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture

或

0123的

这将图表粘贴为图片或绘图，而不是嵌入的Excel对象

Equivelant使用“选择性粘贴...”从菜单。

其它数据类型都可以

http://msdn.microsoft.com/en-us/library/office/aa220339(v=office.11).aspx

来源

2014-08-22 22:53:44

减少从excel粘贴到word图表的文件大小

回答

相关问题