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.