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

Я создавал отчеты, копируя некоторые диаграммы и данные из документа excel в текстовый документ. Я вставляю в элемент управления содержимым, поэтому я использую ChartObject.CopyPicture в excel и ContentControl.Range.Paste в слове. Это делается в цикле:

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 дало файлы размером около 6 МБ, но их создание (с использованием того же рабочего листа и документа) в Office 2010 дает файл, размер которого примерно в 10 раз больше.

После распаковки docx я обнаружил, что дополнительный размер происходит из файлов emf, которые соответствуют диаграммам, которые вставляются при использовании VBA. Там, где они колеблются от 360 до 900 КБ, они составляют 5-18 МБ. И графика не заметно лучше.

Кроме того, это похоже на стиль диаграммы. Я создал новую таблицу и вставил 7 точек данных и соответствующую двумерную круговую диаграмму. С стилем по умолчанию он копируется как эВМ 79 КБ, а со стилем 26 он копирует как ЭМП 10 МБ. Когда я использовал Office 2007, диаграмма будет копироваться как эВМ 700 КБ. Это код:

Sub CopyAndPaste()
    ThisWorkbook.Worksheets("Charts").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    GetObject(, Class:="Word.Application").ActiveDocument.Range.Paste
End Sub

Я могу CopyPicture с форматом xlBitmap, и, хотя это несколько меньше, он больше, чем emf, созданный Office 2007 и заметно более низкого качества. Существуют ли другие варианты уменьшения размера файла? В идеале я хотел бы создать файл с таким же разрешением для диаграмм, как и в Office 2007. Есть ли способ использовать только VBA (без изменения диаграмм в электронной таблице)? В любом случае, я могу легко копировать как объект без ссылки на документы?

Ответ 1

"Это более старый код, сэр, но он проверяет".

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

Ответ 2

Я имел дело с чем-то вроде этого до

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

Document.Range.Paste

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

Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture

или

Document.Range.PasteSpecial DataType:= wdPasteShape

Это приведет к вставке диаграммы как изображения или рисунка, а не к встроенному объекту excel

Равносильно использовать "Вставить Special..." из меню.

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

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

Ответ 3

Возможно, это происходит потому, что файлы .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