MyTetra Share
Делитесь знаниями!
Экспорт диаграмм из Excel в Power Point с помощью VBA
Ссылка на оригинал
Время создания: 16.03.2019 23:43
Текстовые метки: vba_excel, vba_powerpoint
Раздел: Разные закладки - VBA - Excel
Запись: xintrea/mytetra_db_adgaver_new/master/base/15230020464kbwyolc3z/text.html на raw.githubusercontent.com

Экспорт диаграмм из Excel в Power Point с помощью VBA

Задача переноса графиков, диаграмм, таблиц из 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
Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования