81 - Guardar rangos de Excel como Imagen.

 Cuando tenemos que enviar información parcial de alguna hoja, por ejemplo filtrada por Productos, o por Clientes, generalmente guardamos la hoja filtrada y la exportamos.

Aquí vamos a crear el informe como imagen. Sin necesidad de enviar la hoja filtrada sino solamente en un archivo jpg o png.

Para esto contamos con una hoja auxiliar (opcional) y el programa creará una carpeta (si aún no la tenemos) en el mismo directorio donde se encuentra nuestro libro.

Tanto el nombre de la subcarpeta, su ubicación y la extensión del archivo de imagen son argumentos opcionales que pueden ser modificados.

En el ejemplo del libro que se encuentra para descargar, el nombre para el archivo de imagen lo ingresará el usuario mediante un InputBox. Aquí, otra opción podría ser que se tome como 'nombre' el criterio filtrado (nombre del producto o nombre del cliente para este ejemplo).

Como esta macro puede ser utilizada para 2 procesos diferentes, es que tendré 2 llamadas: copiaRango para guardar imágenes en una subcarpeta y llamaUF para enviar un rango a un control de imagen de un Userform (se tratará en el próximo video).

* Traducción y adaptación de la macro del sitio: www.thespreadsheetguru.com

Sub guardaImagen()

nbreArchivo = InputBox("Ingrese el nombre para el archivo de imagen."

If nbreArchivo = "" Then MsgBox "Se canceló el proceso.": Exit Sub

nbreHoja = ActiveSheet.Name

Call exportaImagen(nbreArchivo, nbreHoja)

End Sub

Sub exportaImagen(nombre, hoja)

Dim hoL As Worksheet

Dim hoX As Worksheet

Dim rutaIMG As String

Dim nbreArchImg As String

 

' Establecer referencias a las 2 hojas de trabajo

Set hoL = ThisWorkbook.Sheets(hoja)

Set hoX = ThisWorkbook.Sheets("Hoja1")

Application.ScreenUpdating = False

 

' Obtener la ruta de la carpeta "IMG"     'Ajustar nombre

rutaIMG = ThisWorkbook.Path & "\IMG\"

' Crear la carpeta "IMG" si no existe

If Dir(rutaIMG, vbDirectory) = "" Then

    MkDir rutaIMG  'crear la subcarpeta

End If

'ruta y nombre completo para la imagen

nbreArchImg = rutaIMG & nombre & ".png"      'JPG

 

' Limpiar la hoja auxiliar

hoX.Activate

hoX.Cells.Delete

 

' Definir el rango de la imagen filtrada en la hoja activa

x = hoL.Range("B" & Rows.Count).End(xlUp).Row

If x <= 4 Then MsgBox "No hay datos filtrados.": Exit Sub

rgo = hoL.Range("B4:I" & x).Address

hoL.Range(rgo).CopyPicture Format:=xlPicture

' Pegar la imagen en la hoja "Hoja1" en el rango A1

hoX.Range("A1").PasteSpecial

'luego del pegado el objeto queda seleccionado. Se lo guarda en una variable 

    Set miShape = Selection

'se agrega un objeto chart con las dimensiones del rango

    Set miChart = hoX.ChartObjects.Add(Left:=miShape.Left, Top:=miShape.Top, Width:=miShape.Width, Height:=miShape.Height)

'el objeto seleccionado se pega en el chart y ese objeto se exporta

    miShape.Copy

    miChart.Select

    ActiveChart.Paste

'se guarda la imagen en la subcarpeta

ActiveSheet.ChartObjects(1).Activate

ActiveChart.Export Filename:=nbreArchImg, FilterName:="png"    'JPG

 

'eliminar los objetos agregados en la hoja 1

ActiveSheet.Shapes(1).Delete

ActiveChart.ChartArea.Select

ActiveChart.Parent.Delete

Selection.Delete

 

'se quita el filtro a la lista.

With hoL

    .Select

    .Unprotect

    If .FilterMode = True Then .ShowAllData

    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True

    .[E4].Select

End With

MsgBox "Fin del proceso."

End Sub

Acceso al VIDEO Nº 81 desde aquí.

Descargar libro desde aquí o solicitarlo a mi correo de Gmail.