Export MS Project to MS PowerPoint 2016

[Kurt]

I have the following code:



Sub CreatePowerPoint()


'Add a reference to the Microsoft PowerPoint Library by:
'1. Go to Tools in the VBA menu
'2. Click on Reference
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject

'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If

'Show the PowerPoint
newPowerPoint.Visible = True

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each cht In ActiveSheet.ChartObjects

'Add a new slide where we will paste the chart
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.Sl ides.Count)

'Copy the chart and paste it into the PowerPoint as a Metafile Picture
cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'Set the title of the slide the same as the title of the chart <== Code is stopping here I am sure this has to deal with the references
'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text

'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

activeSlide.Shapes(2).Width = 200
activeSlide.Shapes(2).Left = 505

'If the chart is the "US" consumption chart, then enter the appropriate comments
If InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "US") Then
activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J7").Value & vbNewLine
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J8").Value & vbNewLine)
'Else if the chart is the "Renewable" consumption chart, then enter the appropriate comments
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "Renewable") Then
activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J27").Value & vbNewLine
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J28").Value & vbNewLine)
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J29").Value & vbNewLine)
End If

'Now let's change the font size of the callouts box
activeSlide.Shapes(2).TextFrame.TextRange.Font.Size = 16


Next

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

End Sub


What do I need to fix or change here?


Thanks,

Kurt

[John Wilson]

Is this really MS Project or is it Excel?

I would start by checking that the chart actually has a title


'Set the title of the slide the same as the title of the chart <== Code is stopping here I am sure this has to deal with the references If cht.Chart.HasTitle Then
activeSlide.Shapes.Title.TextFrame.TextRange = cht.Chart.ChartTitle.Text
End If

[Kurt]

Is this really MS Project or is it Excel?
John, you are right it is Excel.

I was trying to see if there was a way to make it work for PowerPoint.

I found a really cool Add Inn - One Pageer Pro that seems to be converting Project to Power Point.

Do you have any code that does this or have you seen any code that does this?