Hello,

I have the following code in an Excel file that works with a PPT file. After the PPT code runs the FinishMerge_Click macro (that code is below my Excel code) in PPT it doesn't switch to PPT so that I can click on the Message Box OK button.

NewStrName in the PPT code will be Category Review + Category Name + BU Name

ANY HELP OUT THERE?

Excel Code:

Sub FinishCategoryReview() 
Dim objPP As Object
Dim objPPFile As Object
Dim strName As String
Dim NewStrName As String


'    ~~> Change this to the relevant file
    strName = GetDesktopPath & "Category Review Template.pptm"
    
Set objPP = CreateObject("PowerPoint.Application")
objPP.Visible = True
 
 
Application.EnableEvents = False
 
objPP.Run "Category Review Template.pptm!Module1.FinishMerge_Click"
 
Application.EnableEvents = True
 


Set objPPFile = Nothing
Set objPP = Nothing


AppActivate "Category Review + Category Name + BU Name.pptx"
 
End Sub
PPT Code:

Sub FinishMerge_Click()


ActivePresentation.Slides.InsertFromFile _
"C:\Users\mogr0002\Downloads\Category Review Grand Canyon - PACKAGED BEVERAGES STORY TEST.pptx", 1, 1, 26


Dim i           As Long
    Dim varrPos     As Variant




    varrPos = Array(34, 34, _
                    36, 36, _
                    38, 38, 38, 38, 38, 38, 38, 38, 38, _
                    40, 40, 40, 40, 40, 40, 40, _
                    43, 43, 43, 43, 43)




    With ActivePresentation
        For i = 0 To UBound(varrPos)
            .Slides(2).MoveTo toPos:=varrPos(i)
        Next i






        NewStrName = .Slides(2).Shapes("Title 1").TextFrame.TextRange.Text
        .Slides(2).Shapes("Title 1").TextFrame.TextRange.Copy
'        .Slides(2).Delete
        .Slides(1).Shapes("Title 1").TextFrame.TextRange.Paste


    With ActivePresentation.Slides(1).Shapes("Title 1")


    With .TextFrame.TextRange.Font


        .Size = 40


        .Name = "Arial"


        .Bold = True




    End With


    Application.ActivePresentation.Slides(1).Shapes("Title 1") _
    .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter


End With




        Application.ActivePresentation.Slides(1).Shapes("FinishMerge").Delete
        Application.ActivePresentation.Slides(1).Shapes("Oval 6").Delete
        .SaveAs GetDesktopPath & NewStrName & ".pptx"
    End With




    MsgBox "Congratulations! Your new Category Review has been saved. You can now begin your Category Review work in this file.", vbInformation


End Sub