Настройка сохранения и группировки графиков

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Настройка сохранения и группировки графиков (Макросы/Sub)

akatorginak

Дата: Вторник, 26.07.2022, 16:52 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Форумчане, доброго времени суток!
Столкнулся со следующей проблемой в макросе:
[vba]

Код

Sub СОБРАТЬ_ГРАФИКИ()

    ActiveSheet.ChartObjects("Диаграмма 8").Copy
    Range("A90").Select
    ActiveSheet.PasteSpecial Format:="Рисунок (PNG)", Link:=False, DisplayAsIcon:=False

    ActiveSheet.ChartObjects("Диаграмма 6").Copy
    Range("F90").Select
    ActiveSheet.PasteSpecial Format:="Рисунок (PNG)", Link:=False, DisplayAsIcon:=False

    ActiveSheet.ChartObjects("Диаграмма 7").Copy
    Range("A110").Select
    ActiveSheet.PasteSpecial Format:="Рисунок (PNG)", Link:=False, DisplayAsIcon:=False

    ActiveSheet.ChartObjects("Диаграмма 4").Copy
    Range("F110").Select
    ActiveSheet.PasteSpecial Format:="Рисунок (PNG)", Link:=False, DisplayAsIcon:=False

    ActiveSheet.Shapes.Range(Array("Picture 1", "Picture 2", "Picture 3", "Picture 4")).Group

End Sub

[/vba]

Суть макроса - копирует 4 графика которые есть в книге, вставляет их в определенные места как картинки и группирует (для удобства дальнейшей копии в презентацию).
Проблема в следующем - если что то подкорректировать, картинки удалить и запустить макрос заново - у картинок будут уже другие номера и группировка не сработает.
Есть какое то решение чтобы это исправить или нет?

Доп вопрос для самообучения - можно как то в этой формуле обойтись без "select" (ответ необязателен)?

Ответить

СообщениеФорумчане, доброго времени суток!
Столкнулся со следующей проблемой в макросе:
[vba]

Код

Автор - akatorginak
Дата добавления - 26.07.2022 в 16:52

RAN

Дата: Вторник, 26.07.2022, 17:10 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Поскольку файла нет...
Картинка вставится с индексом
ActiveSheet.Shapes(1). либо ActiveSheet.Shapes(ActiveSheet.Shapes.count)
(Array("Picture 1", "Picture 2", "Picture 3", "Picture 4")) собираете либо по индексам, либо по индексам определяете имена, а по ним массив.
Без Select вполне можно обойтись.

Быть или не быть, вот в чем загвоздка!

Ответить

akatorginak

Дата: Среда, 27.07.2022, 00:58 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Цитата RAN, 26.07.2022 в 17:10, в сообщении № 2 (

)

Поскольку файла нет...

к сожалению, не могу выкладывать с рабочего компьютера. Добавил пример.

К сообщению приложен файл: 4996204.xlsm (19.1 Kb)

Ответить

RAN

Дата: Среда, 27.07.2022, 02:24 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Насчет Select я погорячился. В данном случае без него нельзя.
[vba]

Код

Sub Мяу()
    Dim ar(), i&
    Application.ScreenUpdating = True
    With ActiveSheet
        ReDim ar(.ChartObjects.Count - 1)
        For i = 1 To .ChartObjects.Count
            .ChartObjects(i).Copy
            .Cells(21, 2 + 8 * (i - 1)).Select
            .PasteSpecial Format:="Рисунок (PNG)", Link:=False, DisplayAsIcon:=False
            ar(i - 1) = .Shapes.Count
        Next
        .Shapes.Range(ar).Group
    End With
    Application.ScreenUpdating = False
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

Настройка сохранения и группировки графиков (Макросы/Sub)

Страница 1 из 1
1