Range to Image (JPEG) is not working anymore (from Excel 2007 to O365)

Question

I need to convert a range to a picture and saved that picture as a JPEG which I can then use for different purposes (e.g. email sending). Now I have switched to O365 compared to Excel2007 and with that switch the picture is always empty with a border only. It seems like there were any issues within my code which I have attached below. Please do you have any idea what the problem could be?

Thanks and best regards, Susann

Sub Range_To_Image()
'erstellt von den markierten Zellen eine Bilddatei (GIF)
Dim Zellbereich As Range
Dim Anz_Markierungen As Integer
Dim Bild As Picture
Dim Diagramm As ChartObject

On Error GoTo Hell 'falls "Abbrechen" gedrückt wird
'Zellen markieren (Bildbereich)
Set Zellbereich = Sheets("OE Daily Summary").Range("A6:O66")
On Error GoTo 0

Application.ScreenUpdating = False

Zellbereich.Copy
Worksheets.Add
Set Bild = ActiveSheet.Pictures.Paste(Link:=True)
Bild.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Set Diagramm = ActiveSheet.ChartObjects.Add(0, 0, Bild.Width, Bild.Height)

With Diagramm
.Chart.Paste
.Chart.Export Filename:=ActiveWorkbook.Path & "\OE_Daily_Summary" & ".jpg", FilterName:="jpg"
End With

Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Application.ScreenUpdating = True

Set Diagramm = Nothing
Set Bild = Nothing
Set Zellbereich = Nothing
Exit Sub

Hell:
MsgBox "", , "Abbruch"
End Sub

This [related question](https://stackoverflow.com/q/32136985/2127508) might be of use — barrowc, Jun 21 '19 at 11:20

Axel Richter · Answer 1 · 2019-06-21T12:18:05.837

It is not clear to me why the Picture object is necessary. There is a Range.CopyPicture method.

Bu main issue is that the ChartObject needs be activated before pasting the picture to it.

The following works for me using Excel 385.

Sub Export()

 Dim oWs As Worksheet
 Dim oRng As Range
 Dim oChrtO As ChartObject
 Dim lWidth As Long, lHeight As Long

 Set oWs = ActiveWorkbook.Worksheets("OE Daily Summary")
 Set oRng = oWs.Range("A6:O66")

 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 'This is necessary
 With oChrtO.Chart
  .Paste
  .Export Filename:=ActiveWorkbook.Path & "\OE_Daily_Summary" & ".jpg", Filtername:="JPG"
 End With

 oChrtO.Delete

End Sub

Range to Image (JPEG) is not working anymore (from Excel 2007 to O365)

1 Answers1