Задача переноса графиков, диаграмм, таблиц из Excel в презентацию PowerPoint осложняется тем, что в последних версиях редактора презентаций (2007, 2010) разработчики убрали возможность записи производимых действий в макрос. Поэтому, для настройки внешнего вида презентации под собственные условия, нужно перерыть документацию по VBA для PowerPoint, либо просмотреть множество специализированных форумов. Ниже приведен код примера создания презентации из диаграмм Excel.
Private Sub export_to_pp() Set pr = CreateObject(“PowerPoint.Application«) Set mpr = pr.Presentations.Add ’Определение имени создаваемой презентации ppName = «Имя_для_презентации» ’Добавление пустого слайда Set ppSlide = mpr.Slides.Add(mpr.Slides.Count, ppLayoutBlank) ’Цвет фона слайда ppSlide.Master.Background.Fill.ForeColor.RGB = RGB(200, 200, 200) ’Добавление блока (Orientation, Left, Top, Width, Height) ’функция Application.CentimetersToPoints переводит сантиметры в пиксели Set TextShape = ppSlide.Shapes.AddTextbox(1, _ Application.CentimetersToPoints(1.09), _ Application.CentimetersToPoints(1.2), _ Application.CentimetersToPoints(22.86), _ Application.CentimetersToPoints(1.2)) TextShape.TextFrame.TextRange.Text = «Текст надписи» ’Настройка параметров блока с текстом TextShape.TextFrame.TextRange.Font.Name = «Calibri» TextShape.TextFrame.TextRange.Font.Size = 18 TextShape.TextFrame.TextRange.Font.Bold = True ’Отключение автоматического подгона размера блока под текст TextShape.TextFrame.AutoSize = 0 TextShape.Height = Application.CentimetersToPoints(1.2) TextShape.TextFrame.TextRange.Font.Color = vbWhite ’Вертикальное выравнивание текста по центру TextShape.TextFrame.VerticalAnchor = msoAnchorMiddle ’Копируем диаграмму в PowerPoint ListName.ChartObjects(“ChartName”).Copy Set chart1 = ppSlide.Shapes.PasteSpecial(ppPastePNG) chart1.Left = Application.CentimetersToPoints(1.52) chart1.Top = Application.CentimetersToPoints(3.65) ’Копируем таблицу как OLE object ListName.Range(“H51:M60”).Copy Set table1 = ppSlide.Shapes.PasteSpecial(ppPasteOLEObject) table1.Left = Application.CentimetersToPoints(1.52) table1.Top = Application.CentimetersToPoints(13.72) ’Копируем таблицу как рисунок ListName.Range(“H61:M70«).Copy Set table2 = ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile) table2.Left = Application.CentimetersToPoints(13.16) table2.Top = Application.CentimetersToPoints(13.72) Application.CutCopyMode = False ’Сохраняем презентацию в папке с текущей книгой Excel mpr.SaveAs (ThisWorkbook.Path + «\» + ppName) mpr.Close pr.Quit End Sub
Если нужно создать презентацию не с нуля, а из заранее созданного шаблона, то вместо 2 и 3 строчек:
tmplPath = «C:\Template\» tmplName = «Шаблон.pptx» ’Проверка существования файла tmplName If Dir(tmplPath & tmplName) = «” Then MsgBox «Файл не найден:» & Chr(13) & tmplPath & tmplName Exit Sub End If Set pr = CreateObject(“PowerPoint.Application”) Set mpr = pr.Presentations.Open(Filename:=tmplPath & tmplName)
Источники
- Форум программистов и сисадминов — Необходимо в MS Excel написать макрос, который бы формировал презентацию в Power Point
- Форум программистов и сисадминов — Копирование чартов из Excel в PowerPoint
- Поддержка Microsoft — Автоматизация PowerPoint с помощью Visual Basic
- SQL.ru — При управлении Power Point из Excel не получается выравнивание в ячейках таблицы
- Microsoft Developer Network — Powerpoint 2007 textframe.autosize
- Tech-Archive.net — VBA changing background on a new slide created by VBA
