From excel to powerpoint - graphs and text.

[Antonio12]

Hello everybody:

I hope someone out there can help me. I'm trying to pass the information on a sheet to a powerpoint presentation. The "Shapes" part is taken care of: but i can't figure out the text part.

I need to be able to pass the text written in a cell to the textbox in the powerpoint presentation.





This is what I have so far.



Sub CreatePowerPoint()


Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
Dim shpTest As Table
Dim rngCell As Range


On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0

If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If

If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If

newPowerPoint.Visible = True

For Each cht In ActiveSheet.ChartObjects

newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
newPowerPoint.ActiveWindow.Selection.ShapeRange.TOP = 125
activeSlide.Shapes(2).Width = 200
activeSlide.Shapes(2).Left = 505

Next

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

End Sub


Thank you all for the help

 

[Worf]

Ola Antonio

Try this:

Sub CreatePowerPoint()
Dim newPowerPoint As PowerPoint.Application, activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject, Cell As Range, ap As PowerPoint.Presentation
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If newPowerPoint Is Nothing Then Set newPowerPoint = New PowerPoint.Application
If newPowerPoint.Presentations.Count = 0 Then newPowerPoint.Presentations.Add
newPowerPoint.Visible = True
Set ap = newPowerPoint.ActivePresentation
Set Cell = ActiveSheet.Range("d20")
For Each cht In ActiveSheet.ChartObjects
    ap.Slides.Add ap.Slides.Count + 1, ppLayoutText
    newPowerPoint.ActiveWindow.View.GotoSlide ap.Slides.Count
    Set activeSlide = ap.Slides(ap.Slides.Count)
    activeSlide.Shapes(2).TextFrame.TextRange.Text = Cell.Value ' the text box
    cht.Select
    ActiveChart.ChartArea.Copy
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125
    activeSlide.Shapes(2).Width = 200
    activeSlide.Shapes(2).Left = 505
    Set Cell = Cell.Offset(1)
Next
Set activeSlide = Nothing
Set newPowerPoint = Nothing
End Sub