Fine tune Excel to Powerpoint Code

[Sirius Black]

Thanks Andy for this awesome piece of code:

Sub Chart2PPT()
    Dim objPPT As Object
    Dim objPrs As Object
    Dim objSld As Object
    Dim shtTemp As Object
    Dim chtTemp As ChartObject
    Dim objShape As Shape
    Dim objGShape As Shape
    Dim intSlide As Integer
    Dim blnCopy As Boolean
    Set objPPT = CreateObject("Powerpoint.application")
    objPPT.Visible = True
    objPPT.Presentations.Add
    objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
    For Each shtTemp In ThisWorkbook.Sheets
        blnCopy = False
        If shtTemp.Type = xlWorksheet Then
            For Each objShape In shtTemp.Shapes 'chtTemp In shtTemp.ChartObjects
                blnCopy = False
                If objShape.Type = msoGroup Then
                    ' if ANY item in group is a chart
                    For Each objGShape In objShape.GroupItems
                        If objGShape.Type = msoChart Then
                            blnCopy = True
                            Exit For
                        End If
                    Next
                End If
                If objShape.Type = msoChart Then blnCopy = True
                If blnCopy Then
                    intSlide = intSlide + 1
                    objShape.CopyPicture
                    ' new slide for each chart
                    objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
                    objPPT.ActiveWindow.View.Paste
                End If
            Next
            If Not blnCopy Then
                ' copy used range
                intSlide = intSlide + 1
                shtTemp.UsedRange.CopyPicture
                ' new slide for each chart
                objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
                objPPT.ActiveWindow.View.Paste
            End If
        Else
            intSlide = intSlide + 1
            shtTemp.CopyPicture
            ' new slide for each chart
            objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
            objPPT.ActiveWindow.View.Paste
        End If
    Next
    Set objPrs = Nothing
    Set objPPT = Nothing
End Sub

What I would like to do, is fine tune it a bit. Right now the code takes charts & tables from all sheets in a workbook. I would like to limit this to only charts on one tab - CHARTS.

I am also looking to tweak this to open an existing presentation, as well as apply a template instead of simply pasting to blank slides.

Any and all help would be greatly appreciated.

Thanks,

Sirius