Guardar rango de celdas de excel 2016 como .jpg

Tengo una macro que la idea es que guarde un rango de celdas como imagen, pero me guarda solo una imagen en blanco, si cambio el rango cambia el tamaño pero sigue en blanco y también si se puede que el nombre sea la fecha para no repetir, ojalá puedan ayudarme, gracias de antemano.

Macro:

Public Sub ScreenShot4()
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Set h1 = Sheets("Hoja1")
Application.DisplayAlerts = False
With h1.Range("A1:G20")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "C:\Reportes\Fecha-Hora.jpg"
.Delete
End With
Application.DisplayAlerts = True
MsgBox "Reporte guardado como imagen."
End Sub

1 Respuesta

Respuesta
1

Intentemos pegar la imagen en la "hoja3"

Crea una hoja nueva y le pones por nombre "hoja3"

Prueba con la siguiente :

Public Sub ScreenShot4()
    Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
    Set h1 = Sheets("Hoja1")
    Set h3 = Sheets("Hoja3")
    h3.Cells.Clear
    '
    Application.DisplayAlerts = False
    With h1.Range("A1:G20")
        Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
    End With
    With h3.ChartObjects.Add(Izq, Arr, Ancho, Alto)
        .Chart.Paste
        .Chart.Export "C:\Reportes\" & Format(Now(), "dd-mm-yyyy-hh-mm") & ".jpg"
        .Delete
    End With
    Application.DisplayAlerts = True
    MsgBox "Reporte guardado como imagen."
End Sub

Avísame cualquier duda, si te funcionó, no olvides valorar.

Ya me guarda la imagen con fecha en el nombre aparece una imagen del tamaño del rango pero completamente blanca. 

Tal vez tu máquina procesa muy rápido que no le da tiempo de pegar la imagen y guardarla como imagen, vamos a ponerle un tiempo de espera de un segundo entre cada paso.

Prueba nuevamente

Public Sub ScreenShot4()
    Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
    Set h1 = Sheets("Hoja1")
    Set h3 = Sheets("Hoja3")
    h3.Cells.Clear
    '
    Application.DisplayAlerts = False
    With h1.Range("A1:G20")
        Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
    End With
    With h3.ChartObjects.Add(Izq, Arr, Ancho, Alto)
        Application. Wait Now() + TimeValue("00:00:02")
        DoEvents
        . Chart. Paste
        Application. Wait Now() + TimeValue("00:00:02")
        DoEvents
        .Chart.Export "C:\trabajo\" & Format(Now(), "dd-mm-yyyy-hh-mm") & ".jpg"
        Application. Wait Now() + TimeValue("00:00:02")
        DoEvents
        .Delete
    End With
    Application.DisplayAlerts = True
    MsgBox "Reporte guardado como imagen."
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas