Macro-Excel para exportar imagen
Tengo una macro que se encarga de copiar un gráfico como imagen y exportarlo a una determinada ruta, pero me esta ocurriendo un problema, al ejecutar el código con un botón crea la imagen pero en blanco, si lo hago paso a paso (F8) la crea bien. ¿Qué puede estar pasando? Tengo Office 365 y W10. Tengo dos códigos y en ambos pasa lo mismo:
1.
Sub CopiarCeldasComoImagen()
Application.ScreenUpdating = False
Set h1 = Sheets("Grafico")
Set h2 = Sheets.Add
ruta = "C:\VB_Macro\reportes\"
archivo = ruta & "ReporteCiclo_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "hh.mm") & ".JPEG"
'
rango = "A1:R32"
'
With h1.Range(rango)
fi = .Cells(1, 1).Row
ff = .Rows.Count + fi - 1
ci = .Cells(1, 1).Column
cf = .Columns.Count + ci - 1
Izq = .Cells(1, 1).Left
der = h1.Cells(1, cf + 1).Left
baj = .Cells(1, 1).Top
Arr = h1.Cells(ff + 1, 1).Top
anc = der - Izq
alt = Arr - baj
End With
'
h1.Range(rango).CopyPicture
h2.Shapes.AddChart
With h2.ChartObjects(1)
.Width = anc
.Height = alt
.Chart.Paste
.Chart.Export archivo
.Delete
End With
Application.DisplayAlerts = False
h2.Delete
Application.DisplayAlerts = True
'
MsgBox "Celdas guardadas como imagen en el archivo: " & archivo, vbInformation, Date
End Sub
2.
Sub grafico()
Dim d, t As Date
d = Date
t = Time
ActiveSheet.ChartObjects.Delete
'ActiveSheet.ChartObjects.Clear
ActiveSheet.Shapes.AddChart(xl3DBarStacked100, _
Left:=10, Top:=100, _
Width:=350, Height:=300).Select
ActiveChart.ChartType = xl3DBarStacked100
Application.Wait (Now + TimeValue("0:00:08"))
ActiveChart.SetSourceData Source:=Sheets("Grafico").Range("N4:R14")
ActiveSheet.Shapes.AddChart(xlPie, _
Left:=370, Top:=100, _
Width:=350, Height:=300).Select
ActiveChart.ChartType = xlPie
ActiveChart.SetSourceData Source:=Sheets("Grafico").Range("O15:R16")
ruta = "C:\VB_Macro\reportes\ReporteCiclo_" & Format(d, "ddmmyyyy") & "_" & Format(t, "hh.mm") & ".jpeg"
Application.DisplayAlerts = False
With Sheets("Procesos").Range("A1:F30")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export ruta
.Delete
End With
Application.DisplayAlerts = True
End Sub