Есть ли способ запустить макрос Excel на нескольких листах, чтобы захватить выбранные изображения диапазона и сохранить их локально

Question

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

В прошлом я получал изображения из Excel, но только с активных листов, как показано ниже.

Sub MakePicture()

    Dim rgExp As Range: Set rgExp = Range("A1:G6")
    ''' Copy range as picture onto Clipboard

    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ''' Create an empty chart with exact size of range copied

    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
    Width:=rgExp.Width, Height:=rgExp.Height)
    .Name = "Table"
    .Activate
    End With

    ''' Paste into chart area, export to file, delete the chart.
    Application.EnableEvents = False
    ActiveChart.Paste
    ActiveSheet.ChartObjects("Table").Chart.Export Filename:="C:\SavedRange.jpg", Filtername:="JPG"
    ActiveSheet.ChartObjects("Table").Delete
    Application.EnableEvents = True


End Sub

Ожидаемый результат - получить 5 изображений из 5 листов и сохранить их в библиотеке.

Answer 1

Вы можете попробовать что-то вроде этого.

Sub MakePicture()
Dim rgExp As Range 
Dim WS As Worksheet
''' Copy range as picture onto Clipboard

rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
''' Create an empty chart with exact size of range copied

For each WS in ThisWorkbook.Worksheets
    Set rgExp = WS.Range("A1:G6")
    With WS.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
Width:=rgExp.Width, Height:=rgExp.Height)
    .Name = "Table"
    .Activate
End With

''' Paste into chart area, export to file, delete chart.
    Application.EnableEvents = False
    ActiveChart.Paste
    WS.ChartObjects("Table").Chart.Export Filename:="C:\SavedRange.jpeg", Filtername:="JPEG"
    WS.ChartObjects("Table").Delete
    Application.EnableEvents = True

Next WS
End Sub