How do i identify an open powerpoint presentation in excel?

[zaser]

I'm trying to write a macro that automatically uploads a chart to powerpoint but it currently makes a new presentation everytime I try to do it.

I got the macro from the internet and tried to modify it but nothing I try seems to be working

Here's the code(not my code) below


Sub ChartX2P()


Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object


If ActiveChart Is Nothing Then
MsgBox "Hey, please select a chart first."
Exit Sub
End If


If PowerPointApp Is Nothing Then _
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")


On Error GoTo 0


Application.ScreenUpdating = False


Set myPresentation = PowerPointApp.Presentation.Add


Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly


ActiveChart.ChartArea.Copy


mySlide.Shapes.Paste
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)


myShape.Left = 120
myShape.Top = 10


PowerPointApp.Visible = True
PowerPointApp.Activate


Application.CutCopyMode = False


End Sub

 

[Domenic]

Try the following macro...

Option Explicit

Sub ChartX2P()


    If ActiveChart Is Nothing Then
        MsgBox "Hey, please select a chart first."
        Exit Sub
    End If
    
    Const POWERPOINT_PRESENTATION_FILENAME As String = "sample.pptx" 'change the file name accordingly


    Dim myPresentation As Object
    On Error Resume Next
    Set myPresentation = GetObject(, "PowerPoint.Application").Presentations(POWERPOINT_PRESENTATION_FILENAME)
    If myPresentation Is Nothing Then
        MsgBox "Open the file named '" & POWERPOINT_PRESENTATION_FILENAME & "', and try again!", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    Dim mySlide As Object
    Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
    
    'determine where to position the top of the chart
    '25 represents the gap between the bottom of the title placeholder and top of the chart
    Dim topPos As Single
    With mySlide
        topPos = .Shapes(1).Top + .Shapes(1).Height + 25 'change the gap as desired
    End With
    
    Dim myShape As Object
    ActiveChart.ChartArea.Copy
    Set myShape = mySlide.Shapes.Paste(1)
    With myShape
        .Left = 120
        .Top = topPos
    End With
    
    myPresentation.Parent.Parent.Activate

    
    Set myPresentation = Nothing
    Set mySlide = Nothing
    Set myShape = Nothing
    
End Sub

Let me know if you have any questions, or run into any problems.

Hope this helps!