Reduce file size for charts pasted from excel into word Reduce file size for charts pasted from excel into word vba vba

Reduce file size for charts pasted from excel into word


I've dealt with something like this before

Instead of using

Document.Range.Paste

Try Using

Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture

or

Document.Range.PasteSpecial DataType:= wdPasteShape

This will paste the chart as a picture or drawing as opposed to an embedded excel object

Equivelant to using "Paste Special..." from the menu.

Other DataTypes are available

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


"It's an older code, sir, but it checks out."

It's an old question and I have an even older (possible) solution: you can compress your .EMF files as .EMZ by gzipping it. This will reduce your file size while keeping the image quality.

On VB6 I used zlib.dll and the code below. I renamed the function names to english but I kept all comments in portuguese:

Option Explicit' Declaração das interfaces com a ZLIBPrivate Declare Function gzopen     Lib "zlib.dll" (ByVal file As String, ByVal mode As String) As LongPrivate Declare Function gzwrite    Lib "zlib.dll" (ByVal file As Long, ByRef uncompr As Byte, ByVal uncomprLen As Long) As LongPrivate Declare Function gzclose    Lib "zlib.dll" (ByVal file As Long) As LongPrivate 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 LongPrivate 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 arquivoPublic 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 FunctionFileReadError:    objLogger.GravarEvento "modZLib.FileRead: " & Err.Description & " (" & Err.Number & " - " & Err.Source & ")", logTipoEvento.ErroEnd Function'Compactar um arquivo com o padrão gzipPublic 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 SubFileCompressError:    objLogger.GravarEvento "modZLib.FileCompress:" & Err.Description & " (" & Err.Number & " - " & Err.Source & ")", logTipoEvento.ErroEnd Sub


This is possibly happening because the .emf files are getting scaled incorrectly. Using PNG may resolve the size issue (as mentioned in the comments above), but will still be an issue because they will not be vector images.

If you use AddPicture to add images to your file, then the following page shows a solution wherein you can change the scale and reduce filesize from whatever default is being used. So it might solve your issue.

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