減少從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圖表的文件大小

回答

相關問題