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

Вход

Регистрация

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

 

= Мир MS Excel/Excel to Powerpoint (разрыв связей) VBA - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Excel to Powerpoint (разрыв связей) VBA (Макросы/Sub)
Excel to Powerpoint (разрыв связей) VBA
kotlovan Дата: Вторник, 03.08.2021, 10:53 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 30
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день!
Имеется макрос в Excel, который создает новый документ Powerpoint, создает первый слайд, копирует на него диаграммы из экселя.
Проблема: возможно ли макросом прописать разрыв связей в скопированной в Powerpoint диаграмме с экселем.

Руками это делается следующим образом:
Выделяем объекты в Powerpoint, связь которых с внешним документом Excel хотим разорвать, нажимаем кноку Office - подготовить - изменить ссылки на файлы - разорвать связь.

Возможное решение для макроса - запускать разрыв связей не для выбранной диаграммы, а для всех связанных файлов в Powerpoint. Но после этого необходимо вернуться макросом в файл Excel для продолжения копирования следующей диаграммы. (по факту диаграмма одинаковая, меняются лишь цифры)

[vba]
Код

Sub vPowerpoint()

Sheets("koko").Select

Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideTitle As String

Set PP = New PowerPoint.Application
PP.Visible = True

PP.Presentations.Open Filename:="C:\Users\kotlovan\Documents\Custom\123.pptx", Untitled:=msoTrue
sFileName = "C:\Users\kotlovan\Documents\Custom\LOL.pptx"

Set PPPres = PP.ActivePresentation

Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPSlide.Select

Sheets("shit").Shapes("shape1").Copy

PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

PP.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing
End Sub
[/vba]


Сообщение отредактировал kotlovan - Вторник, 03.08.2021, 11:06
 
Ответить
СообщениеДобрый день!
Имеется макрос в Excel, который создает новый документ Powerpoint, создает первый слайд, копирует на него диаграммы из экселя.
Проблема: возможно ли макросом прописать разрыв связей в скопированной в Powerpoint диаграмме с экселем.

Руками это делается следующим образом:
Выделяем объекты в Powerpoint, связь которых с внешним документом Excel хотим разорвать, нажимаем кноку Office - подготовить - изменить ссылки на файлы - разорвать связь.

Возможное решение для макроса - запускать разрыв связей не для выбранной диаграммы, а для всех связанных файлов в Powerpoint. Но после этого необходимо вернуться макросом в файл Excel для продолжения копирования следующей диаграммы. (по факту диаграмма одинаковая, меняются лишь цифры)

[vba]
Код

Sub vPowerpoint()

Sheets("koko").Select

Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideTitle As String

Set PP = New PowerPoint.Application
PP.Visible = True

PP.Presentations.Open Filename:="C:\Users\kotlovan\Documents\Custom\123.pptx", Untitled:=msoTrue
sFileName = "C:\Users\kotlovan\Documents\Custom\LOL.pptx"

Set PPPres = PP.ActivePresentation

Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPSlide.Select

Sheets("shit").Shapes("shape1").Copy

PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

PP.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing
End Sub
[/vba]
Автор - kotlovan
Дата добавления - 03.08.2021 в 10:53
kotlovan Дата: Вторник, 03.08.2021, 16:26 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 30
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Нашел данный код, который разрывает связь. Проблема в том, что у меня копируются из Excel сгруппированные фигуры группой с названием "Группа 1" со множеством подгрупп внутри. Чтобы данный макрос работал нужно все разгруппировать. Мне не подходит. Как можно его переделать, чтобы он залезал внутрь группы в каждую подгруппу?

[vba]
Код

Sub vbax_59884_ppt_update_break_links()

Dim i As Long
Dim s As Long

On Error Resume Next

With CreateObject("PowerPoint.Application")
.Visible = True
'.Presentations.Open "C:\Users\Avi\Desktop\Avi\Report - Number1.pptm", Untitled:=msoTrue
With .ActivePresentation
For i = 1 To .Slides.Count
For s = 1 To .Slides(i).Shapes.Count
.Slides(i).Shapes(s).LinkFormat.BreakLink
Next s
Next i
End With
End With

End Sub
[/vba]


Сообщение отредактировал kotlovan - Вторник, 03.08.2021, 16:33
 
Ответить
СообщениеНашел данный код, который разрывает связь. Проблема в том, что у меня копируются из Excel сгруппированные фигуры группой с названием "Группа 1" со множеством подгрупп внутри. Чтобы данный макрос работал нужно все разгруппировать. Мне не подходит. Как можно его переделать, чтобы он залезал внутрь группы в каждую подгруппу?

[vba]
Код

Sub vbax_59884_ppt_update_break_links()

Dim i As Long
Dim s As Long

On Error Resume Next

With CreateObject("PowerPoint.Application")
.Visible = True
'.Presentations.Open "C:\Users\Avi\Desktop\Avi\Report - Number1.pptm", Untitled:=msoTrue
With .ActivePresentation
For i = 1 To .Slides.Count
For s = 1 To .Slides(i).Shapes.Count
.Slides(i).Shapes(s).LinkFormat.BreakLink
Next s
Next i
End With
End With

End Sub
[/vba]
Автор - kotlovan
Дата добавления - 03.08.2021 в 16:26
kotlovan Дата: Вторник, 03.08.2021, 17:17 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 30
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Всё, разобрался. Спасибо всем кто пытался помочь и писал в этой теме))
Может кому то понадобиться:

[vba]
Код

Sub óäàëåíèåÑñûëîê()

Dim i As Long
Dim s As Long
Dim r As Long

On Error Resume Next

With CreateObject("PowerPoint.Application")
.Visible = True
'.Presentations.Open "C:\Users\Avi\Desktop\Avi\Report - Number1.pptm", Untitled:=msoTrue
With .ActivePresentation
For i = 1 To .Slides.Count
For s = 1 To .Slides(i).Shapes.Count
For r = 1 To .Slides(i).Shapes(s).GroupItems.Count

.Slides(i).Shapes(s).GroupItems(r).LinkFormat.BreakLink

Next r
Next s
Next i
End With
End With

End Sub
[/vba]
 
Ответить
СообщениеВсё, разобрался. Спасибо всем кто пытался помочь и писал в этой теме))
Может кому то понадобиться:

[vba]
Код

Sub óäàëåíèåÑñûëîê()

Dim i As Long
Dim s As Long
Dim r As Long

On Error Resume Next

With CreateObject("PowerPoint.Application")
.Visible = True
'.Presentations.Open "C:\Users\Avi\Desktop\Avi\Report - Number1.pptm", Untitled:=msoTrue
With .ActivePresentation
For i = 1 To .Slides.Count
For s = 1 To .Slides(i).Shapes.Count
For r = 1 To .Slides(i).Shapes(s).GroupItems.Count

.Slides(i).Shapes(s).GroupItems(r).LinkFormat.BreakLink

Next r
Next s
Next i
End With
End With

End Sub
[/vba]
Автор - kotlovan
Дата добавления - 03.08.2021 в 17:17
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Excel to Powerpoint (разрыв связей) VBA (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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