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
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 SubAví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
