Excel to PowerPoint code

[subtotalatom]

Hello,

i need help on generating powerpoint presentation from my excel sheet. actually i need to find a code that will copy text boxes from sheet "charts & Info powerpoint" when i press the generate powerpoint button.

i can move charts (although you may have a better way of doing it) and can generate the PowerPoint presentation. i just don't the code to move the text box. i assumed it would be similar to moving chart but i am not sure.

assume my textboxs are called Textbox 1, textbox 2, textbox 3 etc

Sub pptfromexcel()

Dim pptapp As PowerPoint.Application
Dim pptppt As PowerPoint.Presentation
Dim pptsld As PowerPoint.Slide

Set pptapp = New PowerPoint.Application
pptapp.Visible = True
pptapp.Activate

Set pptppt = pptapp.Presentations.Add

Set pptsld = pptppt.Slides.Add(1, ppLayoutTitle)
pptsld.Shapes(1).TextFrame.TextRange = "Company Name"
pptsld.Shapes(2).TextFrame.TextRange = "Powerpoint Test"
pptsld.BackgroundStyle = msoBackgroundStylePreset12

Set pptsld = pptppt.Slides.Add(2, ppLayoutTwoObjects)
pptsld.Shapes(1).TextFrame.TextRange = "Slide 2 Test"
pptsld.Shapes(2).TextEffect.FontSize = "18"
pptsld.Shapes(2).TextFrame.TextRange = "[B]THIS IS WHERE NEED TEXT BOX 1[/B]"
pptsld.BackgroundStyle = msoBackgroundStylePreset12

Set pptsld = pptppt.Slides.Add(3, ppLayoutChart)
pptsld.Shapes(1).TextFrame.TextRange = "slide 3 test"
pptsld.BackgroundStyle = msoBackgroundStylePreset12

ActiveSheet.ChartObjects("chart 1").Copy
pptsld.Shapes.Paste

Set pptsld = pptppt.Slides.Add(4, ppLayoutTwoObjects)
pptsld.Shapes(1).TextFrame.TextRange = "Slide 4 Test"
pptsld.Shapes(2).TextEffect.FontSize = "18"
pptsld.Shapes(2).TextFrame.TextRange = "[B]THIS IS WHERE I NEED TEXT BOX 2[/B]"
pptsld.BackgroundStyle = msoBackgroundStylePreset12

Set pptsld = pptppt.Slides.Add(5, ppLayoutTwoObjects)
pptsld.Shapes(1).TextFrame.TextRange = "Slide 5 Test"
pptsld.Shapes(2).TextEffect.FontSize = "18"
pptsld.Shapes(2).TextFrame.TextRange = "[B]THIS IS WHERE NEED TEXT BOX 3[/B]"
pptsld.BackgroundStyle = msoBackgroundStylePreset12

Set pptsld = pptppt.Slides.Add(6, ppLayoutChart)
pptsld.Shapes(1).TextFrame.TextRange = "slide 6 test"
pptsld.BackgroundStyle = msoBackgroundStylePreset12


ActiveSheet.ChartObjects("chart 2").Copy
pptsld.Shapes.Paste
[B]
THIS IS WHERE NEED TEXT BOX 4[/B]

End Sub

[/CODE]

my code above is generally how my presentation will go

Thankyou in advanced.

 

[Worf]

An example:

Sub pptfromexcel()
Dim pptapp As PowerPoint.Application, pptppt As Presentation, pptsld As Slide
Set pptapp = New PowerPoint.Application
pptapp.Visible = True
pptapp.Activate
Set pptppt = pptapp.Presentations.Add
Set pptsld = pptppt.Slides.Add(1, ppLayoutTitle)
pptsld.Shapes(1).TextFrame.TextRange = "Company Name"
pptsld.Shapes(2).TextFrame.TextRange = "Powerpoint Test"
pptsld.BackgroundStyle = msoBackgroundStylePreset12
Set pptsld = pptppt.Slides.Add(2, ppLayoutTwoObjects)
pptsld.Shapes(1).TextFrame.TextRange = "Slide 2 Test"
pptsld.Shapes(2).TextEffect.FontSize = "18"

pptsld.Shapes.AddTextbox(1, 100, 100, 200, 50).TextFrame.TextRange.Text = _
ActiveSheet.OLEObjects("textbox1").Object.Text

pptsld.BackgroundStyle = msoBackgroundStylePreset12
End Sub

 

[subtotalatom]

Hi Worf

Thankyou for the response.

i have update my code with what you have put and it seems to be debug on this part of the code

pptsld.Shapes.AddTextbox(1, 100, 100, 200, 50).TextFrame.TextRange.Text = _
ActiveSheet.OLEObjects("textbox1").Object.Text

 

[Worf]

What is the error message?

Note that text boxes can be ActiveX or form controls, I was assuming ActiveX for you; run the code below to be sure.

Sub test()
Dim obj As OLEObject, oletb%, sht As Worksheet
Set sht = ActiveSheet
oletb = 0
For Each obj In sht.OLEObjects
    If TypeName(obj.Object) Like "TextBox" Then oletb = oletb + 1
Next
MsgBox oletb, , "ActiveX boxes"
MsgBox sht.TextBoxes.Count, , "Form boxes"
End Sub