Ridurre le dimensioni del file per i grafici incollati da Excel in Word

Question

Ho creato report copiando alcuni grafici e dati da un documento Excel in un documento Word. Sto incollando in un controllo dei contenuti, quindi uso ChartObject.CopyPicture in excel e ContentControl.Range.Paste nella parola. Questo viene fatto in un ciclo:

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 

La creazione di questi report utilizzando Office 2007 i file che erano intorno 6MB prodotto, ma la creazione di loro (utilizzando lo stesso foglio di lavoro e documento) in Office 2010 produce un file che è circa 10 volte più grande.

Dopo aver decompresso il documento, ho scoperto che la dimensione extra deriva dai file emf che corrispondono ai grafici incollati in VBA. Dove vanno da 360 a 900 KB prima, sono 5-18 MB. E la grafica non è visibilmente migliore.

Inoltre, sembra essere correlato allo stile grafico. Ho creato un nuovo foglio di calcolo e inserito 7 punti dati e un grafico a torta 2D corrispondente. Con lo stile predefinito, viene copiato come un emf da 79 KB e con lo stile 26 viene copiato come un emf da 10 MB. Quando utilizzavo Office 2007, il grafico veniva copiato come un emf da 700 KB. Questo è il codice:

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

sono in grado di CopyPicture con il formato xlBitmap, e mentre questo è un po 'più piccolo, è più grande della forza elettromotrice generata da Office 2007 e di qualità notevolmente più povera. Ci sono altre opzioni per ridurre le dimensioni del file? Idealmente, mi piacerebbe produrre un file con la stessa risoluzione per i grafici, come ho fatto con Office 2007. Esiste un modo che usa solo VBA (senza modificare i grafici nel foglio di calcolo)? Qualunque modo posso facilmente copiare come oggetto senza collegare i documenti?

Answer 1

"E 'un vecchio codice, signore, ma si estrae."

E 'una vecchia questione e ho una soluzione ancora più vecchio (possibile):. È possibile comprimere i file EMF come .EMZ da gzipping esso Ciò consentirà di ridurre le dimensioni del file mantenendo la qualità dell'immagine

.

su VB6 ho usato zlib.dll e il codice qui sotto ho rinominato i nomi delle funzioni di inglese, ma ho mantenuto tutti i commenti in portoghese:.

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 

Answer 2

Questo è probabilmente possibile perché i file .emf vengono scalati in modo errato. L'uso di PNG può risolvere il problema delle dimensioni (come menzionato nei commenti sopra), ma sarà comunque un problema perché non saranno immagini vettoriali.

Se si utilizza AddPicture per aggiungere immagini al file, la seguente pagina mostra una soluzione in cui è possibile modificare la scala e ridurre il file da qualsiasi valore predefinito viene utilizzato. Quindi potrebbe risolvere il tuo problema.

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

Answer 3

ho affrontato con qualcosa di simile prima

Invece di usare

Document.Range.Paste 

provare a utilizzare

Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture 

o

Document.Range.PasteSpecial DataType:= wdPasteShape 

Ciò incollare il grafico come un quadro o un disegno in contrapposizione a un oggetto di Excel incorporato

equivelant ad usare "Incolla speciale ..." dal menu.

Altri DataTypes sono disponibili

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