Copying Embedded Excel Charts to PPT: Working in "background"

[DMurray3]

Hi All,

Some months ago -with a lot of help from Jon Peltier- I was able to use the detailed macro to copy graphs from excel as objects and paste them to PPT. All works fine in MS 2007.

The original code that was followed is at Jon's Website as:
Paste Each Embedded Chart in the Active Worksheet into a New Slide in the Active Presentation, using the Chart Title as the Slide Title

Using Excel with Other Office Applications http://peltiertech.com/Excel/XL_PPT.html#ixzz1Z6LtqNgk
​

In MS 2010, speed is a little bit of a problem (some 120+ graphs are being pulled), but it eventually works. I would like to know if there is a way to have the macro build the PPT file in "background" (ie:, not showing the user how it is copying and pasting each graph...).

The code I am using follows:

Sub MyChartsAndTitlesToPresentation()
'DTM: DMurray3
'DTM: Original code obtained from http://peltiertech.com/Excel/XL_PPT.html#chartstitlesslides

'DTM: The original code copies charts as "pictures" to ppt. I have modified the code so that
'DTM: charts are copied as an actual "chart".

' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
    With ActiveSheet.ChartObjects(iCht).Chart
    'DTM: We have commented out the section on the "title" because it alters our chart titles in excel (during the "restore")
    'DTM: to plain text and we need to keep those titles based on cells & formulas.
    'DTM: We have moved the "ChartTitle to SlideTitle" to the ppt macro portion of the code further below.
    
    'DTM: ' get chart title
    'DTM: If .HasTitle Then
    'DTM:   sTitle = .ChartTitle.Text
    'DTM:   Else
    'DTM:   sTitle = ""
    'DTM: End If
        
    'DTM: ' remove title (or it will be redundant)
    'DTM: .HasTitle = False
        
    'DTM: Commenting this out because I need the chart "itself" not a "picture copy"
    'DTM: ' copy chart as a picture
    'DTM: .CopyPicture _
    'DTM:    Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        
    'DTM: Added this part to copy the chart "itself"
         ActiveSheet.ChartObjects(iCht).Activate
         ActiveChart.ChartArea.Copy
        
    'DTM: ' restore title
    'DTM: If Len(sTitle) > 0 Then
    'DTM:   .HasTitle = True
    'DTM:   .ChartTitle.Text = sTitle
    'DTM: End If
    End With
    
    'DTM: Macro code in PPT starts here..
    
    ' Add a new slide and paste in the chart
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
    PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
    With PPSlide
        ' paste and then select the chart again
        .Shapes.Paste.Select
        ' align the chart
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        
    'DTM: Working with the chart copied from Excel is referenced as a "Shape" in PowerPoint; PPT will also assign a new
    'DTM: index number to the Shape.
    
    'DTM: Including the code to update the SlideTitle with the ChartTitle. We assume the Chart is the "last" shape
    'DTM: in the Slide, so we use "(.Shapes.Count)" as the index.
       With .Shapes(.Shapes.Count)
        ' get chart title
                If .Chart.HasTitle Then
                    sTitle = .Chart.ChartTitle.Text
                Else
                    sTitle = "***No Chart Title Available***" 'To warn user...
                End If
        ' remove title from chart (or it will be redundant in the Slide)
            .Chart.HasTitle = False
        End With
        
        ' load ChartTitle in SlideTitle
        .Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
    
    'DTM: We do not require "restoring" the chart title, given the title change is only applicable to the ppt.
    
    End With

Next

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

Please forgive any misleading comment-marks.

Any ideas how & where to change my code to get it to work in background will be highly appreciated.

Kind regards,
Danie Murray
(DMurray3)