Уменьшить размер файла для диаграмм, вставленных из Excel в Word

«Это старый код, сэр, но он проверяется».

Это старый вопрос, и у меня есть еще более старое (возможное) решение: вы можете сжать файлы .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

Я уже сталкивался с чем-то подобным раньше

Вместо использования

Document.Range.Paste

Попробуйте использовать

Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture

or

Document.Range.PasteSpecial DataType:= wdPasteShape

При этом диаграмма будет вставлена ​​как изображение или рисунок, а не как встроенный объект Excel.

Аналогично использованию "Специальная вставка ..." из меню.

Доступны другие типы данных

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

Возможно, это происходит из-за неправильного масштабирования файлов .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