vba - resolucion - como poner imagenes del mismo tamaño en power point
Reducir el tamaño del archivo para los gráficos pegados desde Excel a Word (3)
He estado creando informes copiando algunos cuadros y datos de un documento de Excel en un documento de Word. Estoy pegando en un control de contenido, así que uso ChartObject.CopyPicture en excel y ContentControl.Range.Paste en word. Esto se hace en un bucle:
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 creación de estos informes con Office 2007 produjo archivos que rondaban los 6 MB, pero al crearlos (con la misma hoja de cálculo y el mismo documento) en Office 2010 se obtiene un archivo que es aproximadamente 10 veces más grande.
Después de descomprimir el docx, encontré que el tamaño adicional proviene de archivos emf que corresponden a gráficos que se pegan usando VBA. Donde van desde 360 a 900 KB antes, son de 5 a 18 MB. Y los gráficos no son visiblemente mejores.
Aún más, parece estar relacionado con el estilo de gráfico. Creé una nueva hoja de cálculo e inserté 7 puntos de datos y un gráfico circular 2D correspondiente. Con el estilo predeterminado, se copió como una emf de 79 KB, y con el estilo 26 se copia como una emf de 10 MB. Cuando estaba usando Office 2007, el gráfico se copiaría como una emf de 700 KB. Este es el código:
Sub CopyAndPaste()
ThisWorkbook.Worksheets("Charts").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
GetObject(, Class:="Word.Application").ActiveDocument.Range.Paste
End Sub
Soy capaz de copiar imágenes con el formato xlBitmap , y aunque es un poco más pequeño, es más grande que la fem generada por Office 2007 y tiene una calidad notablemente inferior. ¿Hay otras opciones para reducir el tamaño del archivo? Idealmente, me gustaría producir un archivo con la misma resolución para los gráficos que hice con Office 2007. ¿Hay alguna forma de que use VBA solamente (sin modificar los gráficos en la hoja de cálculo)? ¿Puedo copiar fácilmente como un objeto sin vincular los documentos?
"Es un código antiguo, señor, pero lo comprueba".
Es una pregunta antigua y tengo una solución aún más antigua (posible): puedes comprimir tus archivos .EMF como .EMZ si los envías. Esto reducirá el tamaño de su archivo manteniendo la calidad de la imagen.
En VB6 usé zlib.dll y el código a continuación. Cambié el nombre de la función a inglés, pero mantuve todos los comentarios en portugués:
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
Esto posiblemente esté sucediendo porque los archivos .emf se escalan incorrectamente. El uso de PNG puede resolver el problema del tamaño (como se menciona en los comentarios anteriores), pero seguirá siendo un problema porque no serán imágenes vectoriales.
Si usa AddPicture para agregar imágenes a su archivo, entonces la siguiente página muestra una solución en la que puede cambiar la escala y reducir el tamaño del archivo de cualquier valor predeterminado que se esté usando. Por lo que podría resolver su problema.
He tratado con algo como esto antes
En lugar de usar
Document.Range.Paste
Intenta usar
Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture
o
Document.Range.PasteSpecial DataType:= wdPasteShape
Esto pegará el gráfico como una imagen o dibujo en lugar de un objeto Excel incrustado
Equivalente a usar "Pegado especial ..." del menú.
Otros tipos de datos están disponibles
http://msdn.microsoft.com/en-us/library/office/aa220339(v=office.11).aspx