Excel to PowerPoint code

subtotalatom

New Member
Joined
Feb 3, 2020
Messages
14
Office Version
  1. 365
Platform
  1. Windows
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

VBA Code:
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.
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,129
An example:

VBA Code:
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

New Member
Joined
Feb 3, 2020
Messages
14
Office Version
  1. 365
Platform
  1. Windows
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

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

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,129
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.

VBA Code:
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
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,129,747
Messages
5,638,118
Members
417,010
Latest member
jnuss03

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top