Tengo la siguiente macro, que exporta un archivo de imagen a partir de un rango de celdas, funciona correctamente si se hace step by step desde VBA (F8), sin embargo, al correr la macro desde una llamada o desde un botón, la imagen que se exporta sale completamente en blanco, he intentado varias soluciones, pero hasta ahora no ha funcionado ninguna, este es el código:
Sub img()
Application.ScreenUpdating = True
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
With Range("B2:P104")
Application.Wait (Now + TimeValue("0:00:05"))
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
Application.Wait (Now + TimeValue("0:00:05"))
.Chart.Paste
Application.Wait (Now + TimeValue("0:00:05"))
.Chart.Export ActiveWorkbook.Path & "\imagen.jpg"
.Delete
End With
Application.DisplayAlerts = True
End Sub
Intenté con esta otra macro, pero sucede exactamente lo mismo:
Sub ExportarImg()
Sheets("Hoja 1").Select
Dim oWs As Worksheet
Dim oRng As Range
Dim oChrtO As ChartObject
Dim lWidth As Long, lHeight As Long
Set oWs = ActiveSheet
Set oRng = oWs.Range("B2:p104")
Application.Wait (Now + TimeValue("0:00:02"))
oRng.CopyPicture xlScreen, xlPicture
Application.Wait (Now + TimeValue("0:00:02"))
lWidth = oRng.Width
lHeight = oRng.Height
Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
oChrtO.Activate
With oChrtO.Chart
.Paste
.Export Filename:="imagen.jpg", Filtername:="JPG"
End With
oChrtO.Delete
End Sub
Agradecería si alguien sabe cómo solucionar este inconveniente.
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buen día a todos, un gusto saludarlos.
Tengo la siguiente macro, que exporta un archivo de imagen a partir de un rango de celdas, funciona correctamente si se hace step by step desde VBA (F8), sin embargo, al correr la macro desde una llamada o desde un botón, la imagen que se exporta sale completamente en blanco, he intentado varias soluciones, pero hasta ahora no ha funcionado ninguna, este es el código:
Sub img()
Application.ScreenUpdating = True
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
Sheets("Hoja1").Select
With Range("B2:P104")
Application.Wait (Now + TimeValue("0:00:05"))
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
Application.Wait (Now + TimeValue("0:00:05"))
.Chart.Paste
Application.Wait (Now + TimeValue("0:00:05"))
.Chart.Export ActiveWorkbook.Path & "\imagen.jpg"
.Delete
End With
Application.DisplayAlerts = True
End Sub
Intenté con esta otra macro, pero sucede exactamente lo mismo:
Sub ExportarImg()
Sheets("Hoja 1").Select
Dim oWs As Worksheet
Dim oRng As Range
Dim oChrtO As ChartObject
Dim lWidth As Long, lHeight As Long
Set oWs = ActiveSheet
Set oRng = oWs.Range("B2:p104")
Application.Wait (Now + TimeValue("0:00:02"))
oRng.CopyPicture xlScreen, xlPicture
Application.Wait (Now + TimeValue("0:00:02"))
lWidth = oRng.Width
lHeight = oRng.Height
Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
oChrtO.Activate
With oChrtO.Chart
.Paste
.Export Filename:="imagen.jpg", Filtername:="JPG"
End With
oChrtO.Delete
End Sub
Agradecería si alguien sabe cómo solucionar este inconveniente.