Macro para comprimir imagen
Quisiera saber si me pueden apoyar.
Tengo una Macro que me inserta una imagen en Excel, pero al ejecutarla con otra que me envía un mail con dicha imagen en el cuerpo del mensaje hace que pese alrededor de 2 a 3 MB, lo que es bastante pesado para el que recibe el mail, quisiera saber si existe alguna Macro para comprimir las imágenes y así hacer que "pese" menos dicha imagen para ser enviada por Mail.
Mi macro para insertar imagen es:
Sub IMAGEN()
Dim foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
Hoja10.Shapes("IMAGEN").Delete
ruta = "C:\Imagen.jpg"
Set foto = Hoja10.Pictures.Insert(ruta)
With Range("A11: H31 ")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With foto
.Name = "IMAGEN"
.Top = 200
.Left = 0
.Width = Ancho
.Height = 315
End With
Set foto = Nothing
Application.ScreenUpdating = True
End Sub
Tengo una Macro que me inserta una imagen en Excel, pero al ejecutarla con otra que me envía un mail con dicha imagen en el cuerpo del mensaje hace que pese alrededor de 2 a 3 MB, lo que es bastante pesado para el que recibe el mail, quisiera saber si existe alguna Macro para comprimir las imágenes y así hacer que "pese" menos dicha imagen para ser enviada por Mail.
Mi macro para insertar imagen es:
Sub IMAGEN()
Dim foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
Hoja10.Shapes("IMAGEN").Delete
ruta = "C:\Imagen.jpg"
Set foto = Hoja10.Pictures.Insert(ruta)
With Range("A11: H31 ")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With foto
.Name = "IMAGEN"
.Top = 200
.Left = 0
.Width = Ancho
.Height = 315
End With
Set foto = Nothing
Application.ScreenUpdating = True
End Sub
1 Respuesta
Respuesta de Elsa Matilde
1
Encendé la grabadora de macros.
Clic derecho sobre la imagen, opción Formato. En la ventana que se abrirá, pestaña Imagen, presioná el botón Comprimir y seleccioná tus opciones.
Aceptá. Detené la grabadora y en un módulo encontrarás las líneas que tenés que agregar dentro del grupo que empieza con:
With foto
Vas a obtener líneas similares a estas, según lo que selecciones:
(Debes quitar la palabra Selection)
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
NOTA: está trabajado en versión 2003
Sdos. No dejes de comentarme si lo resolviste.
Clic derecho sobre la imagen, opción Formato. En la ventana que se abrirá, pestaña Imagen, presioná el botón Comprimir y seleccioná tus opciones.
Aceptá. Detené la grabadora y en un módulo encontrarás las líneas que tenés que agregar dentro del grupo que empieza con:
With foto
Vas a obtener líneas similares a estas, según lo que selecciones:
(Debes quitar la palabra Selection)
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
NOTA: está trabajado en versión 2003
Sdos. No dejes de comentarme si lo resolviste.
Gracias por tu valioso tiempo Elsa...
Bueno, yo estoy trabajando la macro en Ver. 2007, y, ¿Bueno mmm por lo que entiendo de tu macro modificaría las características de la imagen verdad?..
Mmmm, en si mi problema más a fondo es, que la macro que adjunte en mi pregunta es parte de una macro más grande la cual, como mencione, envía un mail, pero por el tipo de Macro, la cual copia un rango de celdas, en las mismas se encuentra la imagen agregada con la macro de Sub IMAGEN(), pero ya al enviar el mail pesa bastante, lo que quiero es que pese menos de 1 MB, ya intente con opciones de Excel de comprimir imágenes cada vez que se guarde el documento, pero aun así es muy pesado mi correo a envía.
No se si me doy a entender.
De antemano gracias por tus atenciones.
Bueno, yo estoy trabajando la macro en Ver. 2007, y, ¿Bueno mmm por lo que entiendo de tu macro modificaría las características de la imagen verdad?..
Mmmm, en si mi problema más a fondo es, que la macro que adjunte en mi pregunta es parte de una macro más grande la cual, como mencione, envía un mail, pero por el tipo de Macro, la cual copia un rango de celdas, en las mismas se encuentra la imagen agregada con la macro de Sub IMAGEN(), pero ya al enviar el mail pesa bastante, lo que quiero es que pese menos de 1 MB, ya intente con opciones de Excel de comprimir imágenes cada vez que se guarde el documento, pero aun así es muy pesado mi correo a envía.
No se si me doy a entender.
De antemano gracias por tus atenciones.
Lo que hacen las nuevas instrucciones es 'comprimir' la imagen, pasando de resolución 'impresión' (200 ppp) a resolución 'web' (96 ppp) con opción de recortar áreas no visibles y comprimir.
¿Por qué no lo probás y observas el tamaño que te queda del archivo generado?
Y si el peso sigue siendo excesivo, ya no tendrá que ver el tema de las imágenes sino del archivo en general (colores, formatos, contenido en gral).
Si copia un rango de celdas, imagino que solo estás enviando 1 hoja con cierta cantidad de celdas... no debiera pesar tanto.
Si no te hacen falta las fórmulas, podrías pegar la copia como solo valores... no hay mucho más para ajustar.
Espero tus comentarios...
Sdos
Elsa
¿Por qué no lo probás y observas el tamaño que te queda del archivo generado?
Y si el peso sigue siendo excesivo, ya no tendrá que ver el tema de las imágenes sino del archivo en general (colores, formatos, contenido en gral).
Si copia un rango de celdas, imagino que solo estás enviando 1 hoja con cierta cantidad de celdas... no debiera pesar tanto.
Si no te hacen falta las fórmulas, podrías pegar la copia como solo valores... no hay mucho más para ajustar.
Espero tus comentarios...
Sdos
Elsa
