Range to Image (JPEG) больше не работает (от Excel 2007 до O365) - PullRequest
Новая
       33

Range to Image (JPEG) больше не работает (от Excel 2007 до O365)

2 голосов
/ 21 июня 2019

Мне нужно преобразовать диапазон в изображение и сохранить его в формате JPEG, который я затем смогу использовать для различных целей (например, для отправки по электронной почте).Теперь я переключился на O365 по сравнению с Excel2007, и с этим переключателем картинка всегда пуста только с рамкой.Кажется, в моем коде были какие-то проблемы, которые я прикрепил ниже.Пожалуйста, у вас есть идеи, в чем может быть проблема?

Спасибо и наилучшими пожеланиями, Сюзанна 

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

1 Ответ

0 голосов
/ 21 июня 2019

Мне не понятно, зачем нужен объект 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 - диапазон до изображения jpg .

...