akatorginak
Дата: Вторник, 26.07.2022, 16:52 |
Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация:
0
±
Замечаний:
0% ±
Форумчане, доброго времени суток! Столкнулся со следующей проблемой в макросе:
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
Суть макроса - копирует 4 графика которые есть в книге, вставляет их в определенные места как картинки и группирует (для удобства дальнейшей копии в презентацию). Проблема в следующем - если что то подкорректировать, картинки удалить и запустить макрос заново - у картинок будут уже другие номера и группировка не сработает. Есть какое то решение чтобы это исправить или нет? Доп вопрос для самообучения - можно как то в этой формуле обойтись без "select" (ответ необязателен)?
Форумчане, доброго времени суток! Столкнулся со следующей проблемой в макросе:
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
Суть макроса - копирует 4 графика которые есть в книге, вставляет их в определенные места как картинки и группирует (для удобства дальнейшей копии в презентацию). Проблема в следующем - если что то подкорректировать, картинки удалить и запустить макрос заново - у картинок будут уже другие номера и группировка не сработает. Есть какое то решение чтобы это исправить или нет? Доп вопрос для самообучения - можно как то в этой формуле обойтись без "select" (ответ необязателен)? akatorginak
Ответить
Сообщение Форумчане, доброго времени суток! Столкнулся со следующей проблемой в макросе: [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")).GroupEnd Sub
[/vba] Суть макроса - копирует 4 графика которые есть в книге, вставляет их в определенные места как картинки и группирует (для удобства дальнейшей копии в презентацию). Проблема в следующем - если что то подкорректировать, картинки удалить и запустить макрос заново - у картинок будут уже другие номера и группировка не сработает. Есть какое то решение чтобы это исправить или нет? Доп вопрос для самообучения - можно как то в этой формуле обойтись без "select" (ответ необязателен)? Автор - akatorginak Дата добавления - 26.07.2022 в 16:52
RAN
Дата: Вторник, 26.07.2022, 17:10 |
Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Поскольку файла нет... Картинка вставится с индексом 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
Быть или не быть, вот в чем загвоздка!
Ответить
Сообщение Поскольку файла нет... Картинка вставится с индексом 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% ±
к сожалению, не могу выкладывать с рабочего компьютера. Добавил пример.
к сожалению, не могу выкладывать с рабочего компьютера. Добавил пример. akatorginak
Ответить
Сообщение к сожалению, не могу выкладывать с рабочего компьютера. Добавил пример. Автор - akatorginak Дата добавления - 27.07.2022 в 00:58
RAN
Дата: Среда, 27.07.2022, 02:24 |
Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Насчет Select я погорячился. В данном случае без него нельзя.
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
Насчет Select я погорячился. В данном случае без него нельзя.
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
RAN
Быть или не быть, вот в чем загвоздка!
Ответить
Сообщение Насчет Select я погорячился. В данном случае без него нельзя. [vba]
Sub Мяу() Dim ar(); i & Application.ScreenUpdating = Тrue 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 = FalseEnd Sub
[/vba] Автор - RAN Дата добавления - 27.07.2022 в 02:24