Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.02.2018, 14:04   #1
Zhuzha
 
Регистрация: 15.02.2018
Сообщений: 3
По умолчанию Измнение данных в EXCEL PP через макрос EXCEL

Добрый день!
Помогите, пожалуйста разобраться в макросах. Я новичок в этом деле и смогла сделать только первую часть своей задумки. Я понимаю алгоритм, но недостаток знаний не дает мне двигаться дальше. Я буду Вам очень благодарна! Заранее Вам всем огромное спасибо за помощь и терпение!
Цель макроса - брать из данных диаграммы Power Point значения (исходные данные диаграммы в виде встроенного Excel файла) и подставлять их в виде текста под диаграмму. Сейчас это происходит в ручном режиме, т.е. внесли данные в исходные данные диаграммы, итоговые значения пересчитались, диаграмма обновилась и ручками прописываем эти итоговые данные под диаграммой. Макрос для PP пишу только в Excel (управленческое решение).
Я сделала:
1. Открывается нужная презентация
2. Все элементы презентации носят свои названия в PP (чтобы макрос безошибочной попал в нужный объект).
Сейчас в презентации 1 слайд, это тестовая версия. В рабочей версии - их порядка 82 слайдов.
*Диаграмма - называется Диаграмма 1.
Код
Код:
Sub Тест()
Dim objPPApp As Object
Set objPPApp = CreateObject("PowerPoint.Application")
objPPApp.Visible = True
objPPApp.Presentations.Open "C:\Users\a.goncharova\Desktop\Тесты\Prezentacja 01 2018 ТЕСТ.pptx"
objPPApp.Visible = True
End Sub
Насколько я понимаю, нужно выбрать и актив слайд 1. диаграмму 1. (у меня это почему-то не срабатывает). А как зайти в исходные данные диаграммы - не знаю (

Помоги пожалуйста!!!
Изображения
Тип файла: jpg Макрос.jpg (116.1 Кб, 127 просмотров)
Вложения
Тип файла: 7z Prezentacja 01 2018 ТЕСТ.7z (204.1 Кб, 11 просмотров)

Последний раз редактировалось Zhuzha; 27.02.2018 в 14:18. Причина: Добавляю презентацию в 7z
Zhuzha вне форума Ответить с цитированием
Старый 27.02.2018, 14:11   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Zhuzha Посмотреть сообщение
*Презентация в формате pptx, почему-то отказалась крепиться.
запакуйте в архив (zip, rar, 7z - что нравится/проще) и тогда прикрепите архив к сообщению на форуме.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 27.02.2018, 14:18   #3
Zhuzha
 
Регистрация: 15.02.2018
Сообщений: 3
По умолчанию

Все получилось, спасибо огромное!
Zhuzha вне форума Ответить с цитированием
Старый 27.02.2018, 16:22   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Не знаю, то это или нет, но попробуйте такой макрос:
Код:
Sub get_from_PPTX()

Dim PPT As PowerPoint.Application
Dim p As PowerPoint.Presentation
Dim s As Slide
Dim sh As PowerPoint.Shape

  'On Error Resume Next
    Set PPT = CreateObject("PowerPoint.Application")
    
    'PPT.Activate
    'PPT.Visible = True
    'PPT.WindowState = ppWindowMinimized
    PPT.Presentations.Open Filename:="C:\Users\a.goncharova\Desktop\Тесты\Prezentacja 01 2018 ТЕСТ.pptx", _
       ReadOnly:=True, WithWindow:=msoFalse
    For Each s In PPT.Presentations(1).Slides
        For Each sh In s.Shapes
            If sh.HasTable Then
                Debug.Print " name = " & sh.Name
                Debug.Print sh.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text
                If sh.Name = "Table 4" Then
                  MsgBox "В таблице 4 есть текст: " & Chr(13) & _
                      sh.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text
                End If
            End If
        Next
    Next
    PPT.Presentations(1).Close
  
Set PPT = Nothing

End Sub
вот он в файле - Macros_PPTX_demo.rar
Serge_Bliznykov вне форума Ответить с цитированием
Старый 01.03.2018, 18:34   #5
Zhuzha
 
Регистрация: 15.02.2018
Сообщений: 3
По умолчанию

Огромное спасибо! Этот макрос тоже очень интересный, но он работает иначе, берет данные из PP и вставляет в EXCEL. А мне нужно с помощью макроса EXCEL внести правки в excel PP.
Сейчас я добавила в макрос - написание заметок на существующие слайды (может кому-то пригодиться.
Код
Код:
Sub Тест()
Dim objPPApp As Object
Set objPPApp = CreateObject("PowerPoint.Application")
objPPApp.Visible = True
objPPApp.Presentations.Open "C:\Users\a.goncharova\Desktop\Тесты\Prezentacja 01 2018 ТЕСТ.pptx"
objPPApp.Visible = True
objPPApp.Activate

    Dim nCounter As Integer
    Dim oApp As New PowerPoint.Application
    Dim oSlide As Slide

For Each oSlide In oApp.ActivePresentation.Slides


    Dim oShape As Object
    
    Set oShape = oSlide.Shapes.AddLabel(msoTextOrientationHorizontal, 10, 515, 110, 400)
    
    oShape.TextFrame.TextRange.Text = "*PROGNOZA"
    oShape.TextFrame.TextRange.Font.Size = 14
    oShape.TextFrame.TextRange.Font.Name = "Arial"
    oShape.TextFrame.TextRange.Font.Bold = msoTrue
    oShape.TextFrame.TextRange.ParagraphFormat.Alignment = 3

 Next
 
End Sub
Но, саму проблему мне не удалось решить, может кто подскажет как с помощью макроса Excel набрать команду, которая:
1. Выберет нужный объект презентации "Диаграмма 1"
2. Откроет ее встроенный источник данных (там находятся данные, на основании которых строиться и обновляется диаграмма).

Заранее всем огромное спасибо!
Zhuzha вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос для переноса (с удалением) данных с одного листа на другой при появлении дополнительных данных в ячейке - MS Excel Тохес Microsoft Office Excel 2 15.03.2016 22:26
Как через макрос выгрузить excel Radzhab Microsoft Office Excel 6 02.05.2012 14:36
Копирование данных из одного файла Excel в другой через макрос I.P.iX Microsoft Office Excel 0 31.05.2011 22:20
Макрос обработки данных для Excel 2007 Python Фриланс 1 16.02.2010 20:47
Интересный макрос для создания писем в Outlook через Excel Neo007 Microsoft Office Excel 17 19.04.2009 20:44