gmooney100
06-10-2021, 05:44 PM
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
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