Launching PowerPoint from an Excel application

[Tony Bender]

I am struggling to design an application where the user can view a
table and pie chart in an Excel application, and if they want, copy
those pieces into an existing PowerPoint chart deck.

I completed the table and pie chart in Excel. Specifically the pie
chart is labeled Chart1 and the table is a range ("a1:g15") from the
sheet-tab labeled Table1. Through a set of command buttons the user
can toggle between the table and the pie chart, but I want to offer
the ability to copy these into PowerPoint.

My first step is to open PowerPoint and here is the code I used in my
Excel application:

Sub OpenPPT()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation

Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = msoTrue
Set PPPres = PPApp.Presentations.Open("C:\data\TestPPT.ppt")
End Sub

This opens the specific PowerPoint presentation and it opens in the
'normal' view with Slide 1.

Slide 1 consists of two action settings which, with a mouse click,
launch two different macros.
The first PPT macro copies the Excel Pie Chart, adds a new slide to
the PPT deck, and pastes the copied chart onto the new PPT slide, and
then ends up in the SlideSorter view.
The second PPT macro copies a range from the Table1 sheet in Excel,
adds a new slide and then pastes the table onto the new slide.

The issue I have is launching the PPT macros. When PPT opens it is in
the 'normal' view which prevents me from running the PPT macros from
the action settings. I have to open the 'slide show view' in order to
use these action settings.

1. Is there a way to code the PPT to open in the slide show view so
the user simply clicks on an arrow to launch the macro?



2. Is it possible to accomplish all this within an Excel macro? If so
what is the code?

Here is my code for the PPT macros:
Sub CopyPieChart()
Dim ActP As Presentation
Dim NewSlide As Slide
Dim WB1 As Excel.Workbook
Dim Cht1 As Excel.Chart
Dim Tbl1 As Excel.Worksheet
Dim GeoName As Range

Set ActP = ActivePresentation
Set WB1 = Workbooks.Open("C:\Data\TestWkbk3.xls")
Set Cht1 = WB1.Charts("TripPie")
Set Tbl1 = WB1.Sheets("TripTable")
Set GeoName = WB1.Sheets("data").Range("a4")

Application.DisplayAlerts = ppAlertsNone

WB1.Activate
Application.DisplayAlerts = False
Cht1.Activate
ActiveChart.Shapes("Text Box 1").Select
Selection.Delete
Cht1.ChartArea.Copy
Cht1.Deselect

ActiveWindow.ViewType = ppViewSlideSorter
Application.DisplayAlerts = ppAlertsNone

Set NewSlide = ActP.Slides.Add(ActP.Slides.Count + 1,
ppLayoutBlank)
NewSlide.Select

ActiveWindow.ViewType = ppViewSlide
ActiveWindow.View.PasteSpecial (ppPasteEnhancedMetafile)

'******Copies XlPiechart to PPT

ActiveWindow.Selection.ShapeRange.PictureFormat.CropRight = 118.89
ActiveWindow.Selection.ShapeRange.PictureFormat.CropLeft = 76.89
ActiveWindow.Selection.ShapeRange.PictureFormat.CropTop = 80
With ActiveWindow.Selection.ShapeRange
.IncrementLeft -96#
.IncrementTop -70#
End With
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.9, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.9, msoFalse, msoScaleFromBottomRight
End With
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.93, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.93, msoFalse, msoScaleFromBottomRight
End With
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.96, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.96, msoFalse, msoScaleFromBottomRight
End With
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.97, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.97, msoFalse, msoScaleFromBottomRight
End With
ActiveWindow.Selection.ShapeRange.IncrementTop -60.5
ActiveWindow.Selection.Unselect

'********* Copy table to ppt chart:
WB1.Activate
Application.DisplayAlerts = False
Tbl1.Activate
Range("a1:g15").Select
Selection.Copy

ActiveWindow.ViewType = ppViewSlideSorter

ActiveWindow.ViewType = ppViewSlide
ActiveWindow.View.Paste

WB1.Activate
WB1.Application.CutCopyMode = False

ActiveWindow.Selection.SlideRange.Shapes("Group 171").Select
With ActiveWindow.Selection.ShapeRange
.IncrementLeft 194
.IncrementTop 7
.ScaleWidth 1#, msoFalse, msoScaleFromBottomRight
.ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
End With

ActiveWindow.Selection.Unselect

'*********
'Adds Text Box with name of retailer or market

ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal,
18, 78, 462, 28.875).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue
With ActiveWindow.Selection.TextRange.ParagraphFormat
.LineRuleWithin = msoTrue
.SpaceWithin = 1
.LineRuleBefore = msoTrue
.SpaceBefore = 0.5
.LineRuleAfter = msoTrue
.SpaceAfter = 0
End With


ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1,
Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = GeoName
With .Font
.NameAscii = "Arial"
.NameComplexScript = "Arial"
.Size = 18
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
ActiveWindow.Selection.Unselect

'WB1.Close False
WB1.Activate
WB1.Application.CutCopyMode = False
WB1.Application.DisplayAlerts = False
WB1.Close

'ActivePresentation.SlideShowWindow.View.GotoSlide (1)
ActiveWindow.ViewType = ppViewSlideSorter
End Sub

We use MS Excel 2003 and PowerPoint 2003, and both are referenced in
the VBA Project.

Thank you for any help you can offer...

 

[Barb Reinhardt]

Try something like this

PPApp.Run (PPPres.Name & "!MacroName")

HTH,
Barb Reinhardt

 

[Tony Bender]

Try something like this

 PPApp.Run (PPPres.Name & "!MacroName")

HTH,
Barb Reinhardt

Barb,

Thank you very much, this works. I am indebted to you

Tony Bender