Tengo esta macro para tomar foto de selección y necesitaría pegarla en un documento Word
Tengo esta macro para tomar foto de selección:
Sub TomaFoto()
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
Y necesitaría abrir un documento Word, pegando la imagen y guardar el documento Word en la misma dirección
1 respuesta
Te anexo la macro
Sub TomaFoto()
'Act.Por.Dante Amor
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Dim Wordapn As Object
'
Application.DisplayAlerts = False
Sheets("Foto1").Activate
ActiveSheet.Unprotect Password:="1"
'
Ruta = ThisWorkbook.Path
With Selection
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
'
Set Wordapn = CreateObject("Word.Application") 'crear nueva aplicación Word
With Wordapn
.Visible = True
.Activate
End With
Wordapn.Documents.Add 'crear nuevo documento Word
Wordapn.Selection.PasteAndFormat 13 'Type:=wdListCombineWithExistingList
Wordapn.ActiveDocument.SaveAs "c:\trabajo\" & ActiveSheet.Name & ".docx" 'guardar como
Wordapn.Quit
'
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "J:\" & ActiveSheet.Name & ".jpg"
'.Chart.Export "C:\trabajo\" & ActiveSheet.Name & ".jpg"
.Delete
End With
Application.DisplayAlerts = True
MsgBox "Fin"
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Me da error en la cuarta línea:
Sheets("Foto1").Activate
Revisa que tu hoja se llame "foto1"
O cambia en la macro "foto1" por el nombre de tu hoja.
Que le pongo para que me ponga la hoja que este la selección, la uso en todas la páginas
Quita esta línea de la macro
Sheets("Foto1").Activate
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
