Creating PowerPoint

[Paleo]

Is there a way I may create a PowerPoint file through VBA in excel?
:dunno :dunno :dunno :help :dunno :dunno :dunno :help

[Jacob Hilderbrand]

Try this


Option Explicit

Sub Macro1()
Dim AppPPT As Object
Dim Pre As Object
Set AppPPT = CreateObject("Powerpoint.Application")
Set Pre = AppPPT.Presentations.Add
AppPPT.Visible = True
End Sub

[Paleo]

Great Jacob,

but what about putting some content in it and saving it? I mean creating more than one slide.

[Paleo]

Hi Jacob,

I have tried to create the code by my own, but it didnt work (what a surprise, hum?? :) ).

Well, anyway to code is here if can help me out.



Sub Macro1()
Dim AppPPT As Object
Dim Pre As Object
Set AppPPT = CreateObject("Powerpoint.Application")
Set Pre = AppPPT.Presentations.Add
AppPPT.Visible = True
With AppPPT
.ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutTitle).SlideIndex
.ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With .ActiveWindow.Selection.TextRange
.text = "Presentation"
With .Font
.Name = "Arial"
.Size = 44
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppTitle
End With
End With
.ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With .ActiveWindow.Selection.TextRange
.text = "Presenter"
With .Font
.Name = "Arial"
.Size = 32
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
.ActiveWindow.Selection.Unselect
.ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutText).SlideIndex
.ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With .ActiveWindow.Selection.TextRange
.text = "Title text"
With .Font
.Name = "Arial"
.Size = 44
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppTitle
End With
End With
.ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With .ActiveWindow.Selection.TextRange
.text = "Item 1" + Chr$(CharCode:=13) + "Item 2"
With .Font
.Name = "Arial"
.Size = 32
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
.ActiveWindow.Selection.Unselect
.ActivePresentation.SaveAs Filename:="C:\Documents and Settings\PALEO\My documents\test.ppt"
End With
End Sub

[Jacob Hilderbrand]

Ok, see if this helps you out. In the VBE set a reference to Microsoft PowerPoint #.# Object Library. The # will vary based on your version of Office (i.e. 9.0 = 2000, 10.0 = XP, 11.0 = 2003).


Option Explicit

Sub Macro1()
Dim AppPPT As New PowerPoint.Application
Dim Pre As Presentation
Dim Sld As Slide
Set Pre = AppPPT.Presentations.Add
AppPPT.Visible = True
Set Sld = Pre.Slides.Add(Index:=1, Layout:=ppLayoutText)
With Sld
.Shapes(1).TextFrame.TextRange.Text = "Title"
.Shapes(2).TextFrame.TextRange.Text = "Main Document"
End With
End Sub

When you want to add another slide just change the index number to 2, then 3 etc. Or it can be a variable inside of a loop.

[Paleo]

Great Jacob,

worked just fine!! Thanks!!

[Jacob Hilderbrand]

You're Welcome :)

Take Care