H o l a:
Te anexo la macro con los ajustes para que funcione con la versión de office365
Sub CopiarCeldasComoImagen()
'Por.Dante Amor
'
'Application.ScreenUpdating = False
Set h1 = Sheets("Hoja2")
Set h2 = Sheets.Add
ruta = ThisWorkbook.Path & "\"
archivo = ruta & h1.[D1] & ".JPEG"
'
rango = "A1:C10"
'
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
DoEvents
H2. Shapes. AddChart
DoEvents
Application. Wait Now + TimeValue("00:00:01")
DoEvents
With h2.ChartObjects(1)
.Width = anc
.Height = alt
.Chart.Paste
.Chart.Export archivo
DoEvents
'.Delete
End With
Application.DisplayAlerts = False
h2.Delete
Application.DisplayAlerts = True
'
MsgBox "Celdas guardadas como imagen en el archivo: " & archivo, vbInformation, Date
End Sub
.
![](//blob.todoexpertos.com/uploads/md/1f99e16f4238f180990faac05eb2c5f7.jpg)
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.