Помогите пожалуйста решить задачку. НАДО: скопировать группу графиков из excel в презентацию powerpoint.
Подробнее. Имеются графики в файле экселя, эти три графика сгруппированы в группу под названием Client111. Так же есть код, привожу ниже, он умеет копировать 1 активный график (ActiveChart) в активный слайд презентации. Мне надо скопировать группу графиков. Через запись макроса это выглядит ActiveSheet.Shapes.Range(Array("Client111")), но если я подставляю в имеющийся код вместо ActiveChart, то выдает ошибку. Подскажите как правильно прописать?
Код который мне почти подходит:
[vba]
Код
Sub ChartAsPicture()
Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim obJChart As Chart Dim objPasted As Variant ActiveSheet.Shapes.Range(Array("Client111")).Select If ActiveChart Is Nothing Then MsgBox ("Выберите график") Exit Sub End If
On Error Resume Next
Set PPApp = GetObject(, "Powerpoint.Application")
If PPApp Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active presentation Set PPPres = PPApp.ActivePresentation
If PPPres Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active slide Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
If PPSlide Is Nothing Then MsgBox ("Выберите слайд")
Do While PPSlide Is Nothing Set PPSlide = PPPres.Slides _ (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) DoEvents Loop End If
On Error GoTo 0
Set obJChart = ActiveChart obJChart.ChartArea.Copy
objPasted.Left = objPasted.Left - 30 objPasted.Top = objPasted.Top + 20 Set objPasted = objPasted.Ungroup Set objPasted = objPasted.Ungroup End Sub
[/vba]
Добрый день!
Помогите пожалуйста решить задачку. НАДО: скопировать группу графиков из excel в презентацию powerpoint.
Подробнее. Имеются графики в файле экселя, эти три графика сгруппированы в группу под названием Client111. Так же есть код, привожу ниже, он умеет копировать 1 активный график (ActiveChart) в активный слайд презентации. Мне надо скопировать группу графиков. Через запись макроса это выглядит ActiveSheet.Shapes.Range(Array("Client111")), но если я подставляю в имеющийся код вместо ActiveChart, то выдает ошибку. Подскажите как правильно прописать?
Код который мне почти подходит:
[vba]
Код
Sub ChartAsPicture()
Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim obJChart As Chart Dim objPasted As Variant ActiveSheet.Shapes.Range(Array("Client111")).Select If ActiveChart Is Nothing Then MsgBox ("Выберите график") Exit Sub End If
On Error Resume Next
Set PPApp = GetObject(, "Powerpoint.Application")
If PPApp Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active presentation Set PPPres = PPApp.ActivePresentation
If PPPres Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active slide Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
If PPSlide Is Nothing Then MsgBox ("Выберите слайд")
Do While PPSlide Is Nothing Set PPSlide = PPPres.Slides _ (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) DoEvents Loop End If
On Error GoTo 0
Set obJChart = ActiveChart obJChart.ChartArea.Copy
Елена, изменила 3 строчки, копируются все 3 графика на один активный слайд: [vba]
Код
Sub ChartAsPicture()
Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim obJChart As Shape '--------------------------------ИЗМЕНИЛА ТИП Dim objPasted As Variant '--------------------------------ИЗМЕНИЛА Set obJChart = ActiveSheet.Shapes("Client111") If obJChart Is Nothing Then MsgBox ("Выберите график") Exit Sub End If
On Error Resume Next
Set PPApp = GetObject(, "Powerpoint.Application")
If PPApp Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active presentation Set PPPres = PPApp.ActivePresentation
If PPPres Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active slide Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
If PPSlide Is Nothing Then MsgBox ("Выберите слайд")
Do While PPSlide Is Nothing Set PPSlide = PPPres.Slides _ (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) DoEvents Loop End If
On Error GoTo 0
obJChart.Copy'--------------------------------ИЗМЕНИЛА 'Просто подсократила With PPSlide.Shapes.PasteSpecial(ppPasteShape) .Align msoAlignCenters, True .Align msoAlignMiddles, True .Left = .Left - 30 .Top = .Top + 20 .Ungroup End With End Sub
[/vba]
Елена, изменила 3 строчки, копируются все 3 графика на один активный слайд: [vba]
Код
Sub ChartAsPicture()
Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim obJChart As Shape '--------------------------------ИЗМЕНИЛА ТИП Dim objPasted As Variant '--------------------------------ИЗМЕНИЛА Set obJChart = ActiveSheet.Shapes("Client111") If obJChart Is Nothing Then MsgBox ("Выберите график") Exit Sub End If
On Error Resume Next
Set PPApp = GetObject(, "Powerpoint.Application")
If PPApp Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active presentation Set PPPres = PPApp.ActivePresentation
If PPPres Is Nothing Then MsgBox ("Нет активной презентации") Exit Sub End If
' Reference active slide Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
If PPSlide Is Nothing Then MsgBox ("Выберите слайд")
Do While PPSlide Is Nothing Set PPSlide = PPPres.Slides _ (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) DoEvents Loop End If
On Error GoTo 0
obJChart.Copy'--------------------------------ИЗМЕНИЛА 'Просто подсократила With PPSlide.Shapes.PasteSpecial(ppPasteShape) .Align msoAlignCenters, True .Align msoAlignMiddles, True .Left = .Left - 30 .Top = .Top + 20 .Ungroup End With End Sub
Manyasha, Спасибо большое! мне именно это и нужно было! ActiveSheet.Shapes("Client111") Упарилась 50 графиков в презентацию переводить и так ежемесячно, сейчас этот макрос настрою, надеюсь дело в гору пойдет)
Manyasha, Спасибо большое! мне именно это и нужно было! ActiveSheet.Shapes("Client111") Упарилась 50 графиков в презентацию переводить и так ежемесячно, сейчас этот макрос настрою, надеюсь дело в гору пойдет)Leanna
Лучше день потерять, потом за пять минут долететь!
А я у себя обычно делаю так: Настраиваю размер диаграмм, таблиц и прочих нужных вещей в Excel (все то, что должно переноситься в презентацию) так, чтобы это был реальный размер, нужный в презентации. Сейчас, для простоты, буду писать только про диаграммы. Выделяю те ячейки Excel, которые попадают под нужные диаграммы (именно ячейки, саму презентацию не выделяю), копирую, перехожу в РР, на вкладке Главная жмк на стрелочку под кнопкой Вставить, выбираю Специальная вставка, ставлю точку на Связать и выбираю Лист Excel. В итоге получается связь с файлом Excel. При изменении данных в файле Excel там перерисовывается диаграмма и автоматически она перерисовывается и в РР.
А я у себя обычно делаю так: Настраиваю размер диаграмм, таблиц и прочих нужных вещей в Excel (все то, что должно переноситься в презентацию) так, чтобы это был реальный размер, нужный в презентации. Сейчас, для простоты, буду писать только про диаграммы. Выделяю те ячейки Excel, которые попадают под нужные диаграммы (именно ячейки, саму презентацию не выделяю), копирую, перехожу в РР, на вкладке Главная жмк на стрелочку под кнопкой Вставить, выбираю Специальная вставка, ставлю точку на Связать и выбираю Лист Excel. В итоге получается связь с файлом Excel. При изменении данных в файле Excel там перерисовывается диаграмма и автоматически она перерисовывается и в РР._Boroda_
_Boroda_, я меняю шкалу каждый месяц почти на каждой диаграмме(макросом), а это изменение не синхронизируется таким способом. Поэтому заново вставлять надо. Ещё я выделила ячейки и у меня получились края вокруг в ячейках - так и должно быть? и ещё если я просто делаю копировать - вставить у меня автоматически вставляется так, как со связью - т.е. изменения в экселе транслируются в презентацию. чем это отличается от спц.вставки со связью?
и может до кучи ещё добавлю, что у меня много где в графиках подписи взяты из ячеек и когда кто то открывает на другом компе, то там нет тех подписей, а висит какая то системная надпись.
_Boroda_, я меняю шкалу каждый месяц почти на каждой диаграмме(макросом), а это изменение не синхронизируется таким способом. Поэтому заново вставлять надо. Ещё я выделила ячейки и у меня получились края вокруг в ячейках - так и должно быть? и ещё если я просто делаю копировать - вставить у меня автоматически вставляется так, как со связью - т.е. изменения в экселе транслируются в презентацию. чем это отличается от спц.вставки со связью?
и может до кучи ещё добавлю, что у меня много где в графиках подписи взяты из ячеек и когда кто то открывает на другом компе, то там нет тех подписей, а висит какая то системная надпись.Leanna
Лучше день потерять, потом за пять минут долететь!
У меня получилось обновить связь - тогда подтягивается шкала. И это очень хорошо) только теперь во прос что делать с ячейками которые вокруг диаграммы вылезают и отображаются?)
У меня получилось обновить связь - тогда подтягивается шкала. И это очень хорошо) только теперь во прос что делать с ячейками которые вокруг диаграммы вылезают и отображаются?)Leanna
я меняю шкалу каждый месяц почти на каждой диаграмме(макросом), а это изменение не синхронизируется таким способом
Это не понял. Шкалу на оси? Если да, то я тоже меняю и все переносится. Более того, расширение-сужение строк-столбцов тоже транслируется в РР. Получается что-то по типу инструмента Камера в Excel.
я выделила ячейки и у меня получились края вокруг в ячейках
Да, все правильно. Переносится ВСЁ то, что есть на листе Excel. Я обычно делаю диаграммы на отдельном листе Excel, в котором на вкладке Вид снимаю галку Отображать сетку. Можно еще закрасить сетку белой линией, но это 1. не по феншую и 2. сработает только на презентации без подложки, а часто бывает, что в презентации под диаграммами еще какой-то рисунок есть.
если я просто делаю копировать - вставить у меня автоматически вставляется так, как со связью
Не совсем. Измениния-то отображаются, но при обычном копипасте в РР вставляется как бы кусочек Excel - в него прямо внутри презентации можно зайти даблкликом как в Excel и что-то поменять мунуя исходный файл Excel. А при вставке объекта связью изменить что-то в РР можно, только изменив это что-то в исходном файле Excel. От шаловливых ручек очень помогает.
подписи взяты из ячеек и когда кто то открывает на другом компе, то там нет тех подписей, а висит какая то системная надпись
Это при обычном копипасте? Предположу, что подписи из ячеек делались в Excel 2013-2016, а открывались презентации в офисах 2010 и меньше. А если опять же вставлять связью объекта, то такого быть не должно.
В общем, с моей точки зрения, сплошные плюсы в этом методе. Кроме, разве что, одного минуса - при открытии презентации выскакивает запрос на обновление связей, в котором нажать "обновить" может только тот человек, у кого на компе лежит исходник Excel. Или, как я тоже иногда делаю, исходник Excel лежит в общем доступе, тогда обновлять может кто угодно.
Кстати, еще плюшка - иногда удобно бывает прямо поверх диаграммы в Excel накидать еще, например, прямоугольников с изменяющимся автоматически текстом, каких-то автоматически меняющихся стрелочек и прочих дополнений, которые в Excel легче всего сделать отдельно от диаграммы и просто наложить на нее. Так вот, все то, что Вы повесите сверцу того диапазона в Excel, который был у Вас выделен при копировании, перенесется и в РР. Поэтому очень удобно бывает лепить меняющиеся тексты. Пример - "Выручка увеличилась на 20%" - синенькое автоматически меняется при изменении показателей в Excel и автоматически переносится и в РР
я меняю шкалу каждый месяц почти на каждой диаграмме(макросом), а это изменение не синхронизируется таким способом
Это не понял. Шкалу на оси? Если да, то я тоже меняю и все переносится. Более того, расширение-сужение строк-столбцов тоже транслируется в РР. Получается что-то по типу инструмента Камера в Excel.
я выделила ячейки и у меня получились края вокруг в ячейках
Да, все правильно. Переносится ВСЁ то, что есть на листе Excel. Я обычно делаю диаграммы на отдельном листе Excel, в котором на вкладке Вид снимаю галку Отображать сетку. Можно еще закрасить сетку белой линией, но это 1. не по феншую и 2. сработает только на презентации без подложки, а часто бывает, что в презентации под диаграммами еще какой-то рисунок есть.
если я просто делаю копировать - вставить у меня автоматически вставляется так, как со связью
Не совсем. Измениния-то отображаются, но при обычном копипасте в РР вставляется как бы кусочек Excel - в него прямо внутри презентации можно зайти даблкликом как в Excel и что-то поменять мунуя исходный файл Excel. А при вставке объекта связью изменить что-то в РР можно, только изменив это что-то в исходном файле Excel. От шаловливых ручек очень помогает.
подписи взяты из ячеек и когда кто то открывает на другом компе, то там нет тех подписей, а висит какая то системная надпись
Это при обычном копипасте? Предположу, что подписи из ячеек делались в Excel 2013-2016, а открывались презентации в офисах 2010 и меньше. А если опять же вставлять связью объекта, то такого быть не должно.
В общем, с моей точки зрения, сплошные плюсы в этом методе. Кроме, разве что, одного минуса - при открытии презентации выскакивает запрос на обновление связей, в котором нажать "обновить" может только тот человек, у кого на компе лежит исходник Excel. Или, как я тоже иногда делаю, исходник Excel лежит в общем доступе, тогда обновлять может кто угодно.
Кстати, еще плюшка - иногда удобно бывает прямо поверх диаграммы в Excel накидать еще, например, прямоугольников с изменяющимся автоматически текстом, каких-то автоматически меняющихся стрелочек и прочих дополнений, которые в Excel легче всего сделать отдельно от диаграммы и просто наложить на нее. Так вот, все то, что Вы повесите сверцу того диапазона в Excel, который был у Вас выделен при копировании, перенесется и в РР. Поэтому очень удобно бывает лепить меняющиеся тексты. Пример - "Выручка увеличилась на 20%" - синенькое автоматически меняется при изменении показателей в Excel и автоматически переносится и в РР_Boroda_
_Boroda_, это очень здорово и полезно, чему вы меня научили, спасибо большое! Про подписи - значения из ячеек завтра с работы картинку покажу. Нет, эксель одинаковый у всех 2013.
_Boroda_, это очень здорово и полезно, чему вы меня научили, спасибо большое! Про подписи - значения из ячеек завтра с работы картинку покажу. Нет, эксель одинаковый у всех 2013.Leanna
Лучше день потерять, потом за пять минут долететь!
вот такая вот ошибка при открытии документа на другом компьютере (вставка ctrl C ctrl V) "[ДИАПАЗОН ЯЧЕЕК]" там написано Проверила сегодня, при вашем совете такой ошибки нет.
Насчет того что бы накидать стрелочек и плюшек, как то вчера пропустила этот совет. Попробую, для меня это вполне удобное решение.
А "связи" можно разорвать при желании?
вот такая вот ошибка при открытии документа на другом компьютере (вставка ctrl C ctrl V) "[ДИАПАЗОН ЯЧЕЕК]" там написано Проверила сегодня, при вашем совете такой ошибки нет.
Насчет того что бы накидать стрелочек и плюшек, как то вчера пропустила этот совет. Попробую, для меня это вполне удобное решение.
Конечно. Выводим в ПБД кнопку "Разорвать связь". И что может быть очень полезно - она действует не на все привязки в текущей презентации к файлу ААА.xls*, а обрубает связь только выделенной картинки. Часть картинок можно оставить связью, а часть - значениями.
Конечно. Выводим в ПБД кнопку "Разорвать связь". И что может быть очень полезно - она действует не на все привязки в текущей презентации к файлу ААА.xls*, а обрубает связь только выделенной картинки. Часть картинок можно оставить связью, а часть - значениями._Boroda_