Fine tune Excel to Powerpoint Code

[Killian]

OK, we can add the code for dealing with groups from the original code. I made a PasteIntoNewSld routine that is called when each case is found

Sub Chart2PPTv3()
    Dim objPPT As Object
    Dim shtTemp As Object
    Dim objShape As Shape
    Dim objGShape As Shape
    ' define the path and name of the presentation to open
    Const PRES_FULL_PATH As String = "C:\TEMP\test.ppt"
    Set objPPT = CreateObject("Powerpoint.application")
    objPPT.Visible = True
    objPPT.Presentations.Open PRES_FULL_PATH
    objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
    Set shtTemp = ThisWorkbook.Sheets("CHARTS")
    If shtTemp.Type = xlWorksheet Then
        For Each objShape In shtTemp.Shapes 'chtTemp In shtTemp.ChartObjects
            If objShape.Type = msoChart Then
                ' intSlide = intSlide + 1
                objShape.CopyPicture
                ' call routine to create new slide
                PasteIntoNewSld objPPT
            ElseIf objShape.Type = msoGroup Then
                ' if ANY item in group is a chart
                For Each objGShape In objShape.GroupItems
                    If objGShape.Type = msoChart Then
                        objGShape.CopyPicture
                        ' call routine to create new slide
                        PasteIntoNewSld objPPT
                        Exit For
                    End If
                Next
            End If
        Next
    End If
    Set objPPT = Nothing
End Sub


Sub PasteIntoNewSld(objApp As Object)
    Const DESIGN_FULL_PATH As String = "C:\Program Files\Microsoft Office\Templates\Presentation Designs\Beam.pot"
    Dim objSld As Object
    Set objSld = objApp.ActivePresentation.Slides.Add( _
    Index:=objApp.ActivePresentation.Slides.Count + 1, Layout:=12)
    objApp.ActiveWindow.View.GotoSlide Index:=objSld.SlideIndex
    objApp.ActiveWindow.View.Paste
    objSld.ApplyTemplate Filename:=DESIGN_FULL_PATH
End Sub