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

16 февраля 2012, VBA, Konstantin

Задача переноса графиков, диаграмм, таблиц из 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)
Источники

Order_macros

Теги: • • • • •
 
Распечатать Распечатать

4 комментария в “Экспорт диаграмм из Excel в Power Point с помощью VBA”

  1. Эдуард:
    10 декабря 2013 в 3:47

    Спасибо! Хороший пример. Буду разбираться.

    Ответить
  2. Hosting:
    15 мая 2017 в 23:29

    В Excel щелкните диаграмму, которую нужно скопировать в другую программу Office, и нажмите сочетание клавиш CTRL+C. Откройте другое приложение Office, щелкните в том месте, где вы хотите вставить диаграмму, и нажмите клавиши CTRL+V.

    Ответить
  3. AlexSinch:
    18 февраля 2018 в 22:25

    Спасибо за статью!

    Ответить

Комментировать

 


На Верх