Jump to content
sky_eyes

Sólo "pega" cuando ejecuto paso a paso

Recommended Posts

Hola,

Me estoy volviendo loca... quiero hacer una macro que copie unas celdas de excel y las guarde como imagen.

El problema que tengo es que el código funciona bien cuando lo ejecuto paso a paso, pero si no, la imagen se queda en blanco, es como si no le direa tiempo a "pegar" la imagen en el chart. He probado añadiendo un Application.Wait (Now + TimeValue("0:00:10")) después de pegar la imagen en el chart pero no funciona. Añadir que si ejecuto paso a paso pero apretando rápido F8 tengo el mismo problema, por eso tengo la sensación que no tiene tiempo de pegar la imagen.

Alguna idea??

El código es el siguiente:

Sub Macro3()

Dim MyChart As Chart

archivo = ThisWorkbook.Path & "\PRUEBA.JPEG"
     
ultimaColumna = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
ultimaFila = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range(Cells(1, 1), Cells(ultimaFila, ultimaColumna)).Select
Selection.CopyPicture
Range("E1").Select
Set MyChart = ActiveSheet.ChartObjects.Add(100, 100, 100, 100).Chart
MyChart.Paste
MyChart.Export archivo

End Sub

 

 

PRUEBA.xlsm

Share this post


Link to post
Share on other sites

Alguna vez me he encontrado con problemas a la hora de pegar imágenes en gráficos, así no hay problema.

'--
Sub Macro3()
CrearImagenRango ActiveSheet.UsedRange, "Prueba"
End Sub

'--
Private Sub CrearImagenRango(RANGO As Range, IMAGEN As String)

Application.ScreenUpdating = False

'Creamos la imagen del rango y la pegamos en la hoja
RANGO.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ActiveSheet.Paste

'Copiamos la imagen del rango y la eliminamos
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Copy
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete

'Añadimos el gráfico y lo redimensionamos
ActiveSheet.Shapes.AddChart.Select
With Selection
   .Height = RANGO.Height
   .Width = RANGO.Width
   .Top = RANGO.Top
   .Left = RANGO.Top
End With
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
   .Line.Visible = msoFalse
   .Fill.ForeColor.RGB = Range("A1").Interior.Color
End With

'Pegamos la imagen del rango en el gráfico
ActiveChart.ChartType = xlColumnClustered
ActiveChart.Paste

'Exportamos el gráfico como .jpg y lo eliminamos
archivo = ThisWorkbook.Path & "\" & IMAGEN & ".jpg"
ActiveChart.Export Filename:=archivo, Filtername:="JPG"
ActiveChart.Parent.Delete

End Sub

 

Share this post


Link to post
Share on other sites

De verdad que muchas gracias...

Pero no lo entiendo, el archivo que me has pasado funciona perfectamente, pero cuando cambio el contenido de una sola celda sucede lo mismo que antes y pega la imagen y hace un chart con los datos del rango (adjunto archivo, sólo he puesto "a" en la celda "A1"). Podría ser por algún tema de configuración de excel?

Gracias

Prueba rango a jpg.xlsm

Share this post


Link to post
Share on other sites

He grabado una macro seleccionando un gráfico y quitándolo todo y como origen de datos una celda vacía, y he copiado las instrucciones en tu código y parece que funciona... sólo una vez me ha fallado pero modificado una celda funciona de nuevo. 

Mil gracias por tu ayuda!

Copio el código, que no me deja adjuntar el archivo.:

Sub GuardarComoImagen()
    CrearImagenRango ActiveSheet.UsedRange
End Sub

'--
Private Sub CrearImagenRango(RANGO As Range)

Application.ScreenUpdating = False

'Creamos la imagen del rango y la pegamos en la hoja
RANGO.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ActiveSheet.Paste

'Copiamos la imagen del rango y la eliminamos
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Copy
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete

'Añadimos el gráfico y lo redimensionamos
ActiveSheet.Shapes.AddChart.Select

With Selection

   .Height = RANGO.Height
   .Width = RANGO.Width
   .Top = RANGO.Top
   .Left = RANGO.Top
End With
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
   .Line.Visible = msoFalse
   '.Fill.ForeColor.RGB = Range("A1").Interior.Color
End With

ActiveChart.SetElement (msoElementPrimaryCategoryAxisNone)
ActiveChart.SetElement (msoElementPrimaryValueAxisNone)
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleNone)
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleNone)
ActiveChart.SetElement (msoElementChartTitleNone)
ActiveChart.SetElement (msoElementDataLabelNone)
ActiveChart.SetElement (msoElementDataTableNone)
ActiveChart.SetElement (msoElementErrorBarStandardDeviation)
ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)
ActiveChart.SetElement (msoElementLegendNone)
ActiveChart.SetElement (msoElementTrendlineNone)
'ActiveSheet.ChartObjects("Gráfico 6").Activate
ActiveChart.PlotArea.Select
Application.CutCopyMode = False
ActiveChart.SetSourceData Source:=Range("N1")

'Pegamos la imagen del rango en el gráfico
ActiveChart.ChartType = xlColumnClustered
ActiveChart.Paste

'Exportamos el gráfico como .jpg y lo eliminamos
archivo = ThisWorkbook.Path & "\PRUEBA.JPEG"
ActiveChart.Export Filename:=archivo, Filtername:="JPG"
ActiveChart.Parent.Delete

End Sub


 

 

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png