Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.97/37: Рейтинг темы: голосов - 37, средняя оценка - 4.97
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
1

Копирование чартов из Excel в PowerPoint

31.01.2011, 22:39. Просмотров 7268. Ответов 10
Метки нет (Все метки)

Всем привет, столкнулся с такой проблемой. У меня есть файл с макросом, в котором происходит автоматическая генерация графиков отчета и всякими дропбоксами, которые тусуют график, каждый лист с отчетом сопровождается листом с пивотом и данными, полученными из него для построения графика. На каждом листе есть кнопочка "выгрузить в PowerPoint". Так вот собственно проблема - как скопировать график на слайд в поверпоинте, чтобы данные были прилеплены к слайду и график не менялся если на листе отчета что то меняется? В поверпоинте есть возможность делать "руками" pastespecial с embed workbook. Но так как макрос с отчетом весь запароленный и очень весомый, копировать из листа с отчетом не вариант. Придумал такую штуку :
1) при выгрузке создавать новую книгу, туда копировать график и целый лист с данными, чтобы не перепутать расположение циферок
2) есть метод для смены всех линков в книге (а информация о данных в сериях графика как раз хранится в виде external линка), которой я успешно меняю названия книги с отчетом на имя темповой, созданной книги
3) копировать график и делать pastespecial на слайд используя вставку с embed worksheet

Но вот незадача - как делать такую вставку?? Нагуглил и намсднил такой вариант
Visual Basic
1
slide.shapes.pastespecial DataType:=ppOLEobjects
- этот вариант делает книгу прямо встроенную в слайд как OLE объект, это совсем не так как получается при вставке "руками". И еще отягощает отсутствие записи макросов для powerpoint(это же так? правда?)

В итоге бьюсь об эту стену уже несколько месяцев, но сейчас петух клюнул в мягкое место, и я совсем не знаю что мне делать. (
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
31.01.2011, 22:39
Ответы с готовыми решениями:

Копирование диаграммы из Excel в Powerpoint со связью
Добрый день, Коллеги. Подскажите пожалуйста по такому вопросу. Нужно скопировать из Excel в...

Excel. Копирование столбца, при заполнении 22-й строки продолжить копирование в соседний столбец
Всем привет. Задача: Есть таблица Excel, заполнены 2 столбца, из них первый - порядковые номера,...

Перенести диаграмму из Excel в PowerPoint
Private Sub export_to_pp() Set pr = CreateObject("PowerPoint.Application") Set mpr =...

Фигуру из PowerPoint перенести в Excel
Задача: Есть презентация в power point. Допустим там одна фигура(изображение). Мне надо её...

Создание презентации PowerPoint из Excel
Здравствуйте, решив предыдущую задачу(отдельное спасибо форумчанину Скрипт) Поставил перед собой...

10
Busine2009
Заблокирован
31.01.2011, 23:53 2
Visual Basic
1
2
3
Sub Макрос1()
Presentations("Диаграмма из Excel.ppt").Slides(1).Shapes.PasteSpecial Link:=msoTrue
End Sub
0
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
01.02.2011, 15:01  [ТС] 3
этот вариант просто делает ссылку на то что было, а мне нужно, чтобы данные были вшиты в PP и можно было бы их менять в независимости от общего макроса, когда презентация уже сделана.
0
Busine2009
Заблокирован
01.02.2011, 15:10 4
Belthazor4,
а как вы вручную вставляете и вас устраивает эта вставка - напишите порядок действий, который вы делаете.
0
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
01.02.2011, 15:23  [ТС] 5
Вот собственно код функции, которая это делает
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Public Function CopyChart(ByVal PPApp, ByVal PPPres, sheet, ChartName, awidth, aheight, atop, aleft, title)
    sheet.Select
    Dim PPSlide
    Dim exc
    Dim fromsht, datasht
    Set fromsht = ActiveSheet
    Set datasht = ThisWorkbook.Worksheets(VBA.Mid(ActiveSheet.name, InStr(ActiveSheet.name, ".") + 2) + " data")
    Set exc = Workbooks.Add
    Application.DisplayAlerts = False
    exc.Sheets(2).Delete
    exc.Sheets(2).Delete
    Application.DisplayAlerts = True
    
    fromsht.ChartObjects(ChartName).chart.ChartArea.Copy
    exc.Sheets(1).Paste
    UnprotectSht datasht
    datasht.Visible = True
    datasht.Copy After:=exc.Sheets(1)
    exc.Sheets(2).PivotTables(1).TableRange2.Clear
    datasht.Visible = False
    ProtectSht datasht
    
    ActiveWorkbook.ChangeLink name:=fromsht.Parent.name, NewName:=exc.name, _
        Type:=xlExcelLinks
    
    PPApp.ActiveWindow.ViewType = 1 'ppViewSlide
    PPApp.ActiveWindow.View.GotoSlide (PPPres.Slides.Count)
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    exc.Sheets(1).ChartObjects(ChartName).Activate
    ActiveChart.ChartArea.Copy
    PPSlide.Select
    PPSlide.Shapes.PasteSpecial Link:=msoTrue '----- вот здесь надо что то вставить =)
    PPSlide.Select
    PPSlide.Shapes(PPSlide.Shapes.Count).Select
    Application.DisplayAlerts = False
    exc.Close
    Application.DisplayAlerts = True
    Dim sr
    Set sr = PPApp.ActiveWindow.Selection.ShapeRange
    sr.width = awidth
    sr.height = aheight
    sr.top = atop
    sr.left = aleft
    Set PPSlide = Nothing
    Set sr = Nothing
End Function
а вызывается она из чего то типа такого
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub GoPPT()
    Dim PPApp, PPPres, filetoopen, pres1, flag
    filetoopen = Application.GetOpenFilename("PowerPoint Presentations, *.*")
    If filetoopen = False Then
        MsgBox "Не выбрано"
        Exit Sub
    Else:
        Set PPApp = CreateObject("Powerpoint.application")
        PPApp.Visible = True
        flag = 0
        For Each pres1 In PPApp.Presentations
            If pres1.FullName = filetoopen Then
                Set PPPres = pres1
                flag = 1
            End If
        Next pres1
        If flag = 0 Then Set PPPres = PPApp.Presentations.Open(filetoopen)
        MakePP PPApp, PPPres, ThisWorkbook.ActiveSheet
    End If
    Set PPApp = Nothing
    Set PPPres = Nothing
End Sub
Visual Basic
1
2
3
4
5
6
Sub MakePP(ByVal PPApp, ByVal PPPres, ByVal sht)
    Dim obj, flag, i, k, arr1()
    arr1 = Array("tvr", "stvr", "num")
    AddSlide PPApp, PPPres
    CopyChart PPApp, PPPres, sht, "main", 560, 320, 120, 80, ""    'sht.Range("b6").value
End Sub
почему так жестко все лагает?? оч долго все происходит. Я так заметил, что с PP плохо сообщается макрос из экселя, другие варианты комбинации всяких там activate'ов тупо вызывают ошибки, код может у меня плоховат???

Добавлено через 8 минут
а как вы вручную вставляете и вас устраивает эта вставка - напишите порядок действий, который вы делаете.
В общем так - я создаю новый ексельник, туда копирую тупо лист с данными, на другой чистый лист я копирую график с ссылкой на файл с макросом, потом переделываю кнопочкой "Edit links" в меню ссылки с одной книги на новую созданную, потом я жму ctrl-c с выделенным графиком новой книги, переключай на PP жму правой кнопкой и выбираю где pastespecial вариант Use destination theme & Embed workbook (H). после этого офис всовывает в файл с презентацией этот созданный темповый эксельник (можно проверить, переименовав .pptx в .zip и там он будет лежать). после этого когда тыкаешь правой кнопкой на график в PP и выбираешь меню Edit data открывается собственно этот вшитый эксельник отдельным окном и там можно менять данные. Вот собственно так.
0
Busine2009
Заблокирован
02.02.2011, 20:07 6
Belthazor4,
я не нашёл, как с помощью VBA получить внедрённый график такой же, как можно вставить вручную.
1
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
03.02.2011, 11:36  [ТС] 7
Цитата Сообщение от Busine2009 Посмотреть сообщение
я не нашёл, как с помощью VBA получить внедрённый график такой же, как можно вставить вручную.
жаль, я вот тоже не смог ничего найти по этому, Блин а ведь это так нужно, может есть вариант из под VB в архив презентации добавить книгу, а потом создать график внутри PP и сделать ссылку на данные? Вообще, если в PP нажать Insert Chart, то тебе сразу создается и открывается эксельник такой, может есть варианты так сделать:
1) создать внутри PP
2) отловить книгу, которая откроется
3) в нее всобачить свои данные
0
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
07.02.2011, 14:38  [ТС] 8
Ни у кого больше нет никаких идей? Я что то ничего не могу найти по этому поводу
0
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
25.02.2011, 13:46  [ТС] 9
разобрался, ответ таков:

Visual Basic
1
PPSlide.Application.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
где PPSlide - объект слайда

Но есть одна проблема - эта строка как-бы нажимает на кнопку в риббоне и действия происходят параллельно коду VBA, и если после этого закрывать книгу, из которой копируем, то происходит нежелательное невставливание файла с данными в презентацию, решил вот таким образом, как лучше это сделать не знаю:

Visual Basic
1
2
3
 For i = 1 To 10000
    DoEvents
  Next
верхняя граница - по желанию, у меня в очень редких случаях 10000 не хватает
0
solomka85
0 / 0 / 0
Регистрация: 03.12.2012
Сообщений: 1
07.12.2012, 10:15 10
Чтобы не гонять цикл впустую можно прописать ожидание нового шейпа на слайде
Visual Basic
1
2
3
4
5
shapesOnSlide = PPSlide.Shapes.Count ' всего шейпов на слайде
PPSlide.Application.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
While PPSlide.Shapes.Count <= shapesOnSlide
    DoEvents
WEnd
Только если возникнет ошибка при вставке такая штука зависнет, поэтому можно либо изначально проверку прикрутить или таймаут написать типа:
Visual Basic
1
2
3
4
5
6
7
shapesOnSlide = PPSlide.Shapes.Count ' всего шейпов на слайде
PPSlide.Application.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
timeOut = 5 ' 5 секунд на вставку
timer1 = DateAdd("s", timeOut, Time) ' время выхода из цикла ожидания
While PPSlide.Shapes.Count <= shapesOnSlide or Time <= timer1
    DoEvents
WEnd
0
Belthazor4
241 / 51 / 6
Регистрация: 05.08.2010
Сообщений: 222
07.12.2012, 17:51  [ТС] 11
Тема давно минувших дней, но этот макрос до сих пор в ходу, а я так и не менял ничего по поводу экспорта в PPT, так что актуально обсуждение.
solomka85, Тут вот какая вещь: шейп то появляется, но к нему не линкуется файл с эксельником. Вообще, хорошая идея, попробую ждать, то тех пор пока объект Workbook у чарта будет доступен. Я согласен, что гонять просто так цикл - это невообразимо жутчайший костылище, но сам метод тоже не сказка. Просто в VBA никак не сделать по другому, поэтому я тогда решил, что сделать такой вариант вэйта не такой уж и огромный костыль, по сравнению со всем методом =) Попробую сделать ожидание до появления встроенной книги - отпишусь как успехи.

Добавлено через 1 час 13 минут
Сделал, все работает, потестил. Жду сначала новый шейп, а потом отлинковку шейпа от внешней книги (в этот момент произойдет прилинковка встроенной книги (по сути вещей, хотя черт его разбери как там все происходит))
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
    On Error GoTo L1
    Dim NumOfShapes As Long
    NumOfShapes = PPSlide.Shapes.Count
    PPSlide.Application.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
    Do While PPSlide.Shapes.Count <= NumOfShapes
        DoEvents
    Loop
    Do While PPSlide.Shapes(PPSlide.Shapes.Count).Chart.ChartData.IsLinked
        DoEvents
    Loop
    GoTo L2
L1: Call MyMsg("ChartOutputError", vbCritical)
    CopyChart = False
    Exit Function
L2: On Error GoTo 0
0
07.12.2012, 17:51
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
07.12.2012, 17:51

Макрос переноски из excel в PowerPoint
Здравствуйте, нужно написать макрос, который выводил бы диаграмму с листа excel в PowerPoint....

Формирование презентации из Excel в PowerPoint
Доброго времени суток друзья, Очень прошу, кто может, помочь в написании макроса. Задача такая: ...

Вставка данных из Excel в PowerPoint
Всем доброго дня! Помогите с решением такой проблемы: workB.Sheets(1).Range(&quot;B2:F8&quot;).Copy...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru