Crear imagen .jpg de rango de celdas

[Domingo]

Hola a todos, encontré hace unos días un ejemplo de código que adapté para crear una imagen .jpg de un rango de celdas y funciona correctamente a excepción de que  cuando visualizas la imagen creada se ven columnas y datos como si en la parte tras la imagen se ven columnas similares a un gráfico de excel y datos que no están en el rango de celdas del que se extrae la imagen, pongo el código para ver si me podéis echar una mano.

Sub CrearImagenRango()
Dim she As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Set a = Sheets("LisCOMPRAS")
    'myfile = "C:\Users\conse\Desktop\Lista COMPRAS\ListaCOMPRAS.jpg"
    myfile = "C:\Users\domin\Desktop\Lista COMPRAS\ListaCOMPRAS.jpg"
    '....
    Range("F180:AK239").CopyPicture
    With Range("F180:AK239")
    Izq = .Left
    Arr = .Top
    Ancho = .Width
    Alto = .Height
    End With
    Range("b23").Select
    ActiveSheet.Shapes.AddChart
    ActiveSheet.ChartObjects(1).Select
    With Selection
    .Width = Ancho
    .Height = Alto
    .Chart.Paste
    .Chart.Export myfile
    .Delete
    End With
    MsgBox ("El archivo de imagen con extensión .JPG se guardó en " & myfile), vbInformation, "INFORMACION"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

 

Un saludo

[Antoni]

Este código funciona correctamente, adáptalo a tus necesidades

Sub Export()
 Dim oWs As Worksheet
 Dim oRng As Range
 Dim oChrtO As ChartObject
 Dim lWidth As Long, lHeight As Long
 Set oWs = ActiveSheet
 Set oRng = oWs.Range("B2:H11")
 oRng.CopyPicture xlScreen, xlPicture
 lWidth = oRng.Width
 lHeight = oRng.Height
 Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
 oChrtO.Activate
 With oChrtO.Chart
  .Paste
  .Export Filename:="Case.jpg", Filtername:="JPG"
 End With
 oChrtO.Delete
End Sub

 

[Domingo]

Adaptado y funciona correctamente, muchas gracias.

Un saludo

[DIEGO ARANDA]

En 31/1/2022 at 4:24 , Antoni dijo:

Este código funciona correctamente, adáptalo a tus necesidades

Sub Export()
 Dim oWs As Worksheet
 Dim oRng As Range
 Dim oChrtO As ChartObject
 Dim lWidth As Long, lHeight As Long
 Set oWs = ActiveSheet
 Set oRng = oWs.Range("B2:H11")
 oRng.CopyPicture xlScreen, xlPicture
 lWidth = oRng.Width
 lHeight = oRng.Height
 Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
 oChrtO.Activate
 With oChrtO.Chart
  .Paste
  .Export Filename:="Case.jpg", Filtername:="JPG"
 End With
 oChrtO.Delete
End Sub

 

Hola Antoni, gracias por tu apoyo en la macro. Estoy tratando de que el nombre del .jpg sea aleatorio de acuerdo al tipo de información que estoy pasando a imagen. y lo otro es poder dar un rango aleatorio también de acuerdo a la cantidad de filas o columnas que tenga el rango de celdas. (necesitaría más masivo el código) Por favor.

[Antoni]

La macro:

Sub Exportar(Rango As Range, Tipo As String)
   Dim Gráfico As ChartObject
   Rango.CopyPicture xlScreen, xlPicture
   Set Gráfico = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=Rango.Width, Height:=Rango.Height)
   Gráfico.Activate
   With Gráfico.Chart
    .Paste
    .Export Filename:="Imagen." & Tipo, Filtername:=Tipo
   End With
   Gráfico.Delete
End Sub

Cómo ejecutarla:

Sub ExportarImagen()
Exportar Range("A1:C7"), "JPG"
End Sub

 

[DIEGO ARANDA]

hace 3 horas, Antoni dijo:

La macro:

Sub Exportar(Rango As Range, Tipo As String)
   Dim Gráfico As ChartObject
   Rango.CopyPicture xlScreen, xlPicture
   Set Gráfico = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=Rango.Width, Height:=Rango.Height)
   Gráfico.Activate
   With Gráfico.Chart
    .Paste
    .Export Filename:="Imagen." & Tipo, Filtername:=Tipo
   End With
   Gráfico.Delete
End Sub

Cómo ejecutarla:

Sub ExportarImagen()
Exportar Range("A1:C7"), "JPG"
End Sub

 

Buen día, gracias por tú atención. Sin embargo, no logro o no entiendo para que se ejecute como quisiera hacerlo. Lo que pasa es que tengo otra macro que me distribuye archivos por cada tipo de empresa, entonces el rango que me arroje cada empresa es el que necesito que sea aleatorio, por ejemplo: (empresa 1 rango: A1:L12) (empresa 2 rango: A1:L5) (empresa 3 rango A1:L8) y así sucesivamente y el nombre del .jpg sea el nombre de  esa empresa (imagino que referenciando la celda donde queda el nombre de la empresa que sería siempre (A2)

Te agradezco la atención y apoyo.

[DIEGO ARANDA]

hace 38 minutos , DIEGO ARANDA dijo:

Buen día, gracias por tú atención. Sin embargo, no logro o no entiendo para que se ejecute como quisiera hacerlo. Lo que pasa es que tengo otra macro que me distribuye archivos por cada tipo de empresa, entonces el rango que me arroje cada empresa es el que necesito que sea aleatorio, por ejemplo: (empresa 1 rango: A1:L12) (empresa 2 rango: A1:L5) (empresa 3 rango A1:L8) y así sucesivamente y el nombre del .jpg sea el nombre de  esa empresa (imagino que referenciando la celda donde queda el nombre de la empresa que sería siempre (A2)

Te agradezco la atención y apoyo.

Ya logré el nombre del archivo sea aleatorio. Me falta es que sea aleatorio el rango que voy a pasar a imagen.

[DIEGO ARANDA]

hace 2 horas, DIEGO ARANDA dijo:

Ya logré el nombre del archivo sea aleatorio. Me falta es que sea aleatorio el rango que voy a pasar a imagen.

Ya logré también el rango dinámico.  Gracias igualmente por el código base.