Сохранение диапазона Excel в качестве картинки

Question

У меня есть лист Excel с несколькими диаграммами и изображениями, который используется в качестве панели мониторинга. Мне нужно сохранить содержимое области в виде изображения. Я нашел этот код, чтобы сохранить область как изображение:

Set sht = ActiveWorkbook.Sheets("Graphical Dashboard")
Set strRng = sht.Range("I1:AC124") ' range to be copied

strRng.CopyPicture xlScreen, xlPicture
lWidth = strRng.Width
lHeight = strRng.Height

Set Cht = sht.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
Cht.Activate
Set oCht = Charts.Add

With oCht
    .Paste
    .Export Filename:=ThisWorkbook.Path & "\SavedRange.jpg", Filtername:="JPG"
End With

Cht.Delete

Но проблема в том, что, хотя он сохраняет изображение, соответствующее области выбранного диапазона, изображение пусто . Кроме того, он добавляет еще один лист с именем «Диаграмма» и вставляет пустое изображение на лист.

Answer 1

Как вы упомянули, файл Excel уже содержит диаграммы в указанном диапазоне, поэтому нет необходимости добавлять объект диаграммы Set Cht = sht.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight).

Я протестировал следующий код, и он работает.

Private Sub Test()
Set sht = ActiveWorkbook.Sheets("Sheet1")
Set strRng = sht.Range("A1:B2") ' range to be copied
Dim oCht As Chart
strRng.CopyPicture xlScreen, xlPicture
lWidth = strRng.Width
lHeight = strRng.Height
Set oCht = Charts.Add
With oCht
    .Paste
    .Export Filename:="D:\SavedRange.jpg", Filtername:="JPG"
End With
End Sub

И если в Excel нет диаграммы, и вы хотите рисовать в VBA, то вам придется установить исходные данные в Диаграмма. .SetSourceData Source:=Sheets("Sheet1").Range("A1:B2")

Answer 2

Хорошо делать все, что VBA не работает для меня. Поэтому я использовал нижеприведенный подход.

1. Выберите и скопируйте диапазон из макроса.

   ActiveWorkbook.Sheets("Graphical Dashboard").Activate
   Range("H80:AB121").Select
   Selection.Copy
   

2. Сохраните содержимое из буфера обмена как изображение.

   # invoke the macro
   xlapp.Application.Run("SelectRangeMacro")
   
   # save the area as a image
   im = ImageGrab.grabclipboard()
   im.save('somefile.png','PNG')