Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Настройка сохранения и группировки графиков - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Настройка сохранения и группировки графиков (Макросы/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]
Код
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" (ответ необязателен)?

Автор - 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 вполне можно обойтись.


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

Автор - RAN
Дата добавления - 26.07.2022 в 17:10
akatorginak Дата: Среда, 27.07.2022, 00:58 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Поскольку файла нет...
к сожалению, не могу выкладывать с рабочего компьютера. Добавил пример.
К сообщению приложен файл: 4996204.xlsm (19.1 Kb)
 
Ответить
Сообщение
Поскольку файла нет...
к сожалению, не могу выкладывать с рабочего компьютера. Добавил пример.

Автор - akatorginak
Дата добавления - 27.07.2022 в 00:58
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]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНасчет 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]

Автор - RAN
Дата добавления - 27.07.2022 в 02:24
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Настройка сохранения и группировки графиков (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!