Anónimo
Macros para tomar Foto a un cuadro de excel
Señor Dante quería hacerle una consulta tengo este modulo de macros para tomar foto a una determinadas celdas en excel, lo cual me funciona a la perfección en el excel 2007.
Pero estoy teniendo un problema cuando los estoy pasando a excel 2016, se ejecuta con normalidad pero la imagen me salen en blanco ya verifique el rango donde quiero tomar mi foto y esta bien pero no entiendo por cuando guarda la imagen me sale en blanco .
Sub TomaFoto_1()
On Error Resume Next
Sheets("FOTO1").Activate
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
With Range("B1:K18")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "C:\Users\steven\Desktop\cd\5.-A_Bayental_MONTO.png"
.Delete
End With
Application.DisplayAlerts = True
End Sub
1 respuesta
quite la instrucción pero no me sale ningún mensaje el proceso corre normal aquí le dejo la foto del excel y las celdas que quiero tomar foto y la carpeta donde se aloja mi foto y sale en blanco.
le dejo una foto del cuadro que quiero tomar foto y el carpeta donde se aloja mi foto.
Te anexo otra opción para que la pruebes:
Sub TomaFoto_1()
'Act.Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h1 = Sheets("FOTO1")
With h1.Range("B1:K18")
Ancho = .Width: Alto = .Height: .CopyPicture
End With
arch = "C:\Users\steven\Desktop\cd\5.-A_Bayental_MONTO.png"
'arch = "C:\trabajo\foto.png"
'
Set h3 = Sheets.Add
h3.Shapes.AddChart
With h3.ChartObjects(1)
.Height = Alto
.Width = Ancho
.Chart.Paste
.Chart.Export arch
End With
h3.Delete
Application.DisplayAlerts = True
End SubSi tampoco te funciona. Lo que se me ocurre es que generes el rango como PDF
Sub TomaFoto_2()
Range("B1:K18").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\steven\Desktop\cd\5.-A_Bayental_MONTO.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End SubSi alguna opción te funciona, no olvides valorar la respuesta.
hola en PDF si sale pero necesito en formato PNG para adjuntar la imagen a un mensaje de envió y hasta hora sigue saliendo en blando mis fotos ,no se si sera por la versión del Windows 7 y el office excel 2016.
Seguro es por la versión 2016. En 2007 no tengo problemas.
Como te comenté no tengo forma de probar en 2016 y de hacer la corrección al código.
Intenta lo siguiente: Activa la grabadora de macros. Realiza manualmente la creación de la imagen. Exporta la imagen a un archivo. Revisa la macro que te creó y la pones aquí para revisarla.
Probaste esta opción:
Sub TomaFoto_1()
'Act.Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h1 = Sheets("FOTO1")
With h1.Range("B1:K18")
Ancho = .Width: Alto = .Height: .CopyPicture
End With
arch = "C:\Users\steven\Desktop\cd\5.-A_Bayental_MONTO.png"
'arch = "C:\trabajo\foto.png"
'
Set h3 = Sheets.Add
h3.Shapes.AddChart
With h3.ChartObjects(1)
.Height = Alto
.Width = Ancho
.Chart.Paste
.Chart.Export arch
End With
h3.Delete
Application.DisplayAlerts = True
End Sub