Exportar Rango como Imagen (Actualizado 2018)

En varias ocasiones me ha sido necesario crear una imagen de las celdas de un hoja de Excel, y en varias ocasiones hice uso de la tecla “imp pnt” el cual es muy útil pero no siempre nos sirve, cuando necesitamos exportar un rango muy grande tenemos que alejar el zoom para poder visualizarlo completo en pantalla y apenas se percibe el contenido de las celdas, entonces tenemos que dividir el rango y crear las imágenes para posteriormente unirlas, pero también hay otra opción que para mí es la mejor y es utilizar un código que convierta las celdas a imagen, de esa forma no importa que no se vea el rango completo en pantalla.
El código que utilizo es el siguiente

Public Sub RangoImagen(Rango As Excel.Range, Archivo As String)
    Dim Imagen As Chart
    Dim Result As Boolean
    With Rango
        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Set Imagen = Rango.Parent.ChartObjects.Add(10, 10, .Width, .Height).Chart
    End With
    Imagen.Paste
    Imagen.ChartArea.Border.LineStyle = 0
    Imagen.ChartArea.Width = Imagen.ChartArea.Width * 3
    Imagen.ChartArea.Height = Imagen.ChartArea.Height * 3
    On Error Resume Next
    Kill Archivo
    Result = Imagen.Export(Archivo)
    Imagen.Parent.Delete
    Set Imagen = Nothing
    If Result Then
        MsgBox "Correcto. Se ha creado la imagen del rango"
    Else
        MsgBox "Error. " & Err.Description
    End If
End Sub


Como ven es un código pequeño pero muy útil, lo que hace es pedir el rango que queremos exportar a imagen y el archivo en que queremos exportarlo.

Primero copiamos el rango como imagen luego creamos un objeto chart que tenga las mismas dimensiones que el rango y pegamos el rango que copiamos en el objeto chart.

With Rango
    .CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set Imagen = Rango.Parent.ChartObjects.Add(10, 10, .Width, .Height).Chart
End With
Imagen.Paste


Después quitamos los bordes del objeto chart

Imagen.ChartArea.Border.LineStyle = 0


Luego Redimensionamos el objeto chart esto con el fin de obtener una mejor calidad en la imagen, se debe tener cuidado porque si hacemos la imagen muy grande se volverá muy pesada y Excel no podrá exportarla.

Imagen.ChartArea.Width = Imagen.ChartArea.Width * 3
Imagen.ChartArea.Height = Imagen.ChartArea.Height * 3


Después eliminamos el archivo (si existiera).

Kill Archivo


Y exportamos el objeto chart

Result = Imagen.Export(Archivo)


Después se elimina y se libera el objeto chart

Imagen.Parent.Delete
Set Imagen = Nothing


Si se exportó el rango se muestra un mensaje de éxito, si no se exportó se muestra un mensaje de error

If Result Then
    MsgBox "Correcto. Se ha creado la imagen del rango"
Else
    MsgBox "Error. " & Err.Description
End If

Para utilizar el código, lo hacemos de la siguiente manera

RangoImagen Rango,Archivo


Por ejemplo

RangoImagen Sheets("Hoja1").Range("A1:D4"),"C:\Users\MyUser\Pictures\CodigoExcel\RangoImagen\Rango.png"

Y ahora ya tenemos la imagen del rango.

Rango en Excel

Rango que se quiere exportar a imagen

Rango en Imagen

Imagen creada por el código

Actualización 6 de mayo de 2018

En versiones recientes de Excel el código exporta una imagen en blanco, al parecer no se permite pegar la imagen sin activar antes el ChartObject, por lo que se tiene que agregar una linea adicional al código quedando como sigue.

Public Sub RangoImagen(Rango As Excel.Range, Archivo As String)
    Dim Imagen As Chart
    Dim Result As Boolean
    With Rango
        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Set Imagen = Rango.Parent.ChartObjects.Add(10, 10, .Width, .Height).Chart
    End With
    Imagen.Parent.Activate'Nueva linea 2018-05-06
    Imagen.Paste
    Imagen.ChartArea.Border.LineStyle = 0
    Imagen.ChartArea.Width = Imagen.ChartArea.Width * 3
    Imagen.ChartArea.Height = Imagen.ChartArea.Height * 3
    On Error Resume Next
    Kill Archivo
    Result = Imagen.Export(Archivo)
    Imagen.Parent.Delete
    Set Imagen = Nothing
    If Result Then
        MsgBox "Correcto. Se ha creado la imagen del rango"
    Else
        MsgBox "Error. " & Err.Description
    End If
End Sub

Anuncios

12 pensamientos en “Exportar Rango como Imagen (Actualizado 2018)

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s