Agregar a continuación del nombre de la hoja la fecha
En esta macro:
Sub Tomar_Foto()
ActiveSheet.Unprotect Password:="1"
Application.DisplayAlerts = False
On Error Resume Next
Sheets("FOTO1").Activate
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
With Selection
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "J:\" & ActiveSheet.Name & ".jpg"
.Delete
End With
Application.DisplayAlerts = True
End Sub
Necesito agregar a continuación del nombre de la hoja la fecha
2 Respuestas
Te anexo la macro actualizada
Sub Tomar_Foto()
ActiveSheet.Unprotect Password:="1"
Application.DisplayAlerts = False
On Error Resume Next
Sheets("FOTO1").Activate
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
With Selection
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "C:\" & ActiveSheet.Name & " " & Format(Date, "dd-mm-yyyy") & ".jpg"
.Delete
End With
Application.DisplayAlerts = True
End Subsal u dos
Como siempre fabuloso y rápido
Gracias Dante
Un saludo
Para probar la macro puse
"C:\"
y tú tenías
"J:\"
Ajusta la macro para que puedas guardar el archivo en J
no me hace nada
no sirve
Prueba de estas
Sub Tomar_Foto()
Dim Nombre As String
ActiveSheet.Unprotect Password:="1"
Application.DisplayAlerts = False
On Error Resume Next
Sheets("FOTO1").Activate
Nombre = ActiveSheet.Name
ActiveSheet.Name = Nombre & " " & Format(Date, "d-mm-yy")
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
With Selection
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "J:\" & ActiveSheet.Name & ".jpg"
.Delete
End With
Application.DisplayAlerts = True
End Sub