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

@Belthazor4 · Регистрация: 05.08.2010

Студворк — интернет-сервис помощи студентам

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

Но вот незадача - как делать такую вставку?? Нагуглил и намсднил такой вариант

Visual Basic
1
slide.shapes.pastespecial DataType:=ppOLEobjects

- этот вариант делает книгу прямо встроенную в слайд как OLE объект, это совсем не так как получается при вставке "руками". И еще отягощает отсутствие записи макросов для powerpoint(это же так? правда?)

В итоге бьюсь об эту стену уже несколько месяцев, но сейчас петух клюнул в мягкое место, и я совсем не знаю что мне делать.

(

@Busine2009 · 31.01.2011, 23:53

Visual Basic
1
2
3
Sub Макрос1()
Presentations("Диаграмма из Excel.ppt").Slides(1).Shapes.PasteSpecial Link:=msoTrue
End Sub

@Belthazor4 · 01.02.2011, 15:01 **[ТС]**

этот вариант просто делает ссылку на то что было, а мне нужно, чтобы данные были вшиты в PP и можно было бы их менять в независимости от общего макроса, когда презентация уже сделана.

@Busine2009 · 01.02.2011, 15:10

Belthazor4,
а как вы вручную вставляете и вас устраивает эта вставка - напишите порядок действий, который вы делаете.

@Belthazor4 · 01.02.2011, 15:23 **[ТС]**

Вот собственно код функции, которая это делает

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 открывается собственно этот вшитый эксельник отдельным окном и там можно менять данные. Вот собственно так.

@Busine2009 · 02.02.2011, 20:07

Belthazor4,
я не нашёл, как с помощью VBA получить внедрённый график такой же, как можно вставить вручную.

@Belthazor4 · 03.02.2011, 11:36 **[ТС]**

Сообщение от Busine2009

я не нашёл, как с помощью VBA получить внедрённый график такой же, как можно вставить вручную.

жаль, я вот тоже не смог ничего найти по этому, Блин а ведь это так нужно, может есть вариант из под VB в архив презентации добавить книгу, а потом создать график внутри PP и сделать ссылку на данные? Вообще, если в PP нажать Insert Chart, то тебе сразу создается и открывается эксельник такой, может есть варианты так сделать:
1) создать внутри PP
2) отловить книгу, которая откроется
3) в нее всобачить свои данные

@Belthazor4 · 07.02.2011, 14:38 **[ТС]**

Ни у кого больше нет никаких идей? Я что то ничего не могу найти по этому поводу

@Belthazor4 · 25.02.2011, 13:46 **[ТС]**

разобрался, ответ таков:

Visual Basic
1
PPSlide.Application.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"

где PPSlide - объект слайда

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

Visual Basic
1
2
3
 For i = 1 To 10000
    DoEvents
  Next

верхняя граница - по желанию, у меня в очень редких случаях 10000 не хватает

07.12.2012, 10:15

Чтобы не гонять цикл впустую можно прописать ожидание нового шейпа на слайде

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

@Belthazor4 · 07.12.2012, 17:51 **[ТС]**

Тема давно минувших дней, но этот макрос до сих пор в ходу, а я так и не менял ничего по поводу экспорта в 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

Новые блоги и статьи Все статьи Все блоги /
Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .
Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025	Расскажи мне о Мире, бродяга kumehtar 12.11.2025 — Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .	PowerShell Snippets iNNOKENTIY21 11.11.2025 Модуль PowerShell 5. 1+ : Snippets. psm1 У меня модуль расположен в пользовательской папке модулей, по умолчанию: \Documents\WindowsPowerShell\Modules\Snippets\ А в самом низу файла-профиля. . .

@Belthazor4 245 / 55 / 6 Регистрация: 05.08.2010 Сообщений: 222
	01.02.2011, 15:01 [ТС]
	этот вариант просто делает ссылку на то что было, а мне нужно, чтобы данные были вшиты в PP и можно было бы их менять в независимости от общего макроса, когда презентация уже сделана. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	01.02.2011, 15:10
	Belthazor4, а как вы вручную вставляете и вас устраивает эта вставка - напишите порядок действий, который вы делаете. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	02.02.2011, 20:07
	Belthazor4, я не нашёл, как с помощью VBA получить внедрённый график такой же, как можно вставить вручную. 1

@Belthazor4 245 / 55 / 6 Регистрация: 05.08.2010 Сообщений: 222
	07.02.2011, 14:38 [ТС]
	Ни у кого больше нет никаких идей? Я что то ничего не могу найти по этому поводу 0