Réduire la taille du fichier pour les graphiques collés d'excel à word
j'ai créé des rapports en copiant des graphiques et des données d'un document excel dans un document word. Je colle dans un contrôle de contenu, donc j'utilise ChartObject.CopyPicture en excel et ContentControl.Range.Paste dans word. Ceci est fait dans une boucle:
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 création de ces rapports à L'aide D'Office 2007 a donné des fichiers d'environ 6 Mo, mais leur création (à l'aide de la même feuille de travail et du même document) dans Office 2010 donne un fichier qui est environ 10 fois plus gros.
après avoir déballé le docx, Je trouvé que la taille supplémentaire vient de fichiers emf qui correspondent à des graphiques qui sont collés en utilisant VBA. Là où ils vont de 360 à 900 KB avant, ils sont 5-18 MB. Et les graphismes ne sont pas visiblement mieux.
Encore plus loin, il semble être lié au Style Graphique. J'ai créé une nouvelle feuille de calcul et inséré 7 points de données et un diagramme à secteurs 2D correspondant. Avec le style par défaut, il a copié comme un emf de 79 KO, et avec le style 26 Il copie comme un emf de 10 Mo. Lorsque J'utilisais Office 2007, le le diagramme serait copié comme un CEM de 700 KB. C'est le code:
Sub CopyAndPaste()
ThisWorkbook.Worksheets("Charts").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
GetObject(, Class:="Word.Application").ActiveDocument.Range.Paste
End Sub
je suis en mesure de CopyPicture avec le format xlBitmap, et bien que ce soit un peu plus petit, il est plus grand que le CEM généré par Office 2007 et de qualité nettement moins bonne. Existe-il d'autres options pour réduire la taille du fichier? Idéalement, je voudrais produire un fichier avec la même résolution pour les graphiques que J'ai utilisé Office 2007. Y a-t-il un moyen qui utilise VBA seulement (sans modifier les graphiques dans le tableur)? Est-ce que je peux facilement copier en tant qu'objet sans lier les documents?
3 réponses
"C'est un vieux code, monsieur, mais il vérifie."
c'est une vieille question et j'ai une solution encore plus ancienne (possible): vous pouvez compresser votre .EMF files as .EMZ par gzipping. Cela réduira la taille de votre fichier tout en conservant la qualité de l'image.
sur VB6 j'ai utilisé zlib.dll et le code ci-dessous. J'ai renommé les noms des fonctions en anglais mais j'ai gardé tous les commentaires en portugais:
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
j'ai eu quelque chose comme ça avant
au Lieu d'utiliser
Document.Range.Paste
Essayez D'Utiliser
Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture
ou
Document.Range.PasteSpecial DataType:= wdPasteShape
cela va coller le graphique comme une image ou un dessin par opposition à un objet excel intégré
Equivelant à l'aide de "collage Spécial..."à partir du menu.
les autres types de données sont disponible
http://msdn.microsoft.com/en-us/library/office/aa220339(v=office.11).aspx
cela se produit peut-être parce que le .les fichiers emf sont mis à l'échelle incorrectement. Utiliser PNG peut résoudre le problème de taille (tel que mentionné dans les commentaires ci-dessus), mais restera un problème car il ne s'agit pas d'images vectorielles.
si vous utilisez AddPicture pour ajouter des images à votre fichier, alors la page suivante montre une solution dans laquelle vous pouvez changer l'échelle et réduire filesize de quelque défaut est utilisé. Donc, il pourrait résoudre votre question.