excel - Range to Image (JPEG) 不再起作用(从 Excel 2007 到 O365)

Question

我需要将范围转换为图片并将该图片保存为 JPEG，然后我可以将其用于不同目的(例如电子邮件发送)。
现在，与 Excel2007 相比，我已切换到 O365，并且通过该切换，图片始终为空，只有边框。我的代码中似乎有任何问题，我附在下面。
请问您知道问题可能是什么吗？

谢谢和最好的问候，
苏珊

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

Answer 1

我不清楚为什么 Picture对象是必要的。有一个Range.CopyPicture方法。

卜主要问题是ChartObject需要在将图片粘贴到它之前激活。

以下适用于我使用 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

另见: VBA - Range to jpg picture .