Name of Chart as slide title

[akhileshgs]

Hi,
In the following macro, how to get the name of the chart as the slide title?

Sub Range_Chart_1() 
      
     'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE 
    Dim PPApp As PowerPoint.Application 
    Dim PPSlide As PowerPoint.Slide 
      
     'Original code sourced from Jon Peltier http://peltiertech.com/Excel/XL_PPT.html 
     'This code developed at http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html 
      
    Dim SheetName As String 
    Dim TestRange As Range 
    Dim TestSheet As Worksheet 
    Dim TestChart As ChartObject 
      
    Dim PasteChart As Boolean 
    Dim PasteChartLink As Boolean 
    Dim ChartNumber As Long 
      
    Dim PasteRange As Boolean 
    Dim RangePasteType As String 
    Dim RangeName As String 
    Dim AddSlidesToEnd As Boolean 
         Dim PPT As PowerPoint.Application 
 Set PPT = New PowerPoint.Application 
  
     
      
     'Parameters 
      
     'SheetName           - name of sheet in Excel that contains the range or chart to copy 
      
     'PasteChart          -If True then routine will  copy and paste a chart 
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link 
     'ChartNumber         -Chart Object Number 
     ' 
     'PasteRange          - If True then Routine will copy and Paste a range 
     'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values 
     'RangeName           - Address or name of range to copy; "B3:G9" "MyRange" 
     'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide. 
      
     'use active sheet. This can be a direct sheet name 
    SheetName = ActiveSheet.Name 
      
     'Setting PasteRange to True means that Chart Option will not be used 
    PasteRange = True 
     
    RangeName = "RANG1" 
    RangePasteType = "Picture" 
    RangeLink = True 
 
      
    PasteChart = True 
    PasteChartLink = False 
    ChartNumber = 3 
      
    AddSlidesToEnd = True 
      
      
     'Error testing 
    On Error Resume Next 
    Set TestSheet = Sheets(SheetName) 
    Set TestRange = Sheets(SheetName).Range(RangeName) 
    Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber) 
    On Error GoTo 0 
      
    If TestSheet Is Nothing Then 
        MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
      
    If PasteRange And TestRange Is Nothing Then 
        MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
      
    If PasteRange = False And PasteChart And TestChart Is Nothing Then 
        MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
      
      
     'Look for existing instance 
    On Error Resume Next 
    Set PPApp = GetObject(, "PowerPoint.Application") 
    On Error GoTo 0 
      
     'Create new instance if no instance exists 
    PPT.Presentations.Open Filename:="D:\DU Dashboard Template.pptx" 
     'Add a presentation if none exists 
 
      
     'Make the instance visible 
    PPApp.Visible = True 
      
     'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation 
    If PPApp.ActivePresentation.Slides.Count = 0 Then 
         PPT.Presentations.Open Filename:="D:\DU Dashboard Template.pptx" 
 
    Else 
        If AddSlidesToEnd Then 
             'Appends slides to end of presentation and makes last slide active 
            PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
            PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count 
            Set PPSlide = PPApp.ActivePresentation.Slides(PPApp.ActivePresentation.Slides.Count) 
        Else 
             'Sets current slide to active slide 
            Set PPSlide = PPApp.ActiveWindow.View.Slide 
        End If 
    End If 
      
     'Options for Copy & Paste Ranges and Charts 
 
        If RangePasteType = "Picture" Then 
             'Paste Range as Picture 
            Worksheets(SheetName).Range(RangeName).Copy 
 
 
            PPSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select 
                 With PPApp.ActiveWindow.Selection.ShapeRange 
                  
 
.Top = 400 ' points 
.Height = 85 
.Left = 40 
 
 
 End With 
 
        Else 
             'Paste Range as HTML 
            Worksheets(SheetName).Range(RangeName).Copy 
 
            PPSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select 
                With PPApp.ActiveWindow.Selection.ShapeRange 
.Top = 400 ' points 
.Height = 85 
.Left = 40 
 
 
 End With 
 
        End If 
 
         'Options for Copy and Paste Charts 
        Worksheets(SheetName).Activate 
        ActiveSheet.ChartObjects(ChartNumber).Select 
        If PasteChartLink = True Then 
             'Copy & Paste Chart Linked 
            ActiveChart.ChartArea.Copy 
            PPSlide.Shapes.PasteSpecial(link:=False).Select 
        Else 
             'Copy & Paste Chart Not Linked 
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
            PPSlide.Shapes.Paste.Select 
        End If 
 
      
     'Center pasted object in the slide 
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 80 
    PPApp.ActiveWindow.Selection.ShapeRange.Left = 15 
    With PPApp.ActiveWindow.Selection.ShapeRange 
.Top = 90 ' points 
.Left = 100 
.Width = 650 
.Height = 300 
  End With 
    AppActivate ("Microsoft PowerPoint") 
    Set PPSlide = Nothing 
    Set PPApp = Nothing 
      
End Sub  

[akhileshgs]

I managed to get this code

            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text  

and inserted in the code like this

Sub Range_Chart_1() 
      
     'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE 
    Dim PPApp As PowerPoint.Application 
    Dim PPSlide As PowerPoint.Slide 
      
     'Original code sourced from Jon Peltier http://peltiertech.com/Excel/XL_PPT.html 
     'This code developed at http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html 
      
    Dim SheetName As String 
    Dim TestRange As Range 
    Dim TestSheet As Worksheet 
    Dim TestChart As ChartObject 
      
    Dim PasteChart As Boolean 
    Dim PasteChartLink As Boolean 
    Dim ChartNumber As Long 
      
    Dim PasteRange As Boolean 
    Dim RangePasteType As String 
    Dim RangeName As String 
    Dim AddSlidesToEnd As Boolean 
         Dim PPT As PowerPoint.Application 
         Dim newPowerPoint As PowerPoint.Application 
        Dim activeSlide As PowerPoint.Slide 
        Dim cht As Excel.ChartObject 
        For Each cht In ActiveSheet.ChartObjects 
 Set PPT = New PowerPoint.Application 
             cht.Select 
  
     
      
     'Parameters 
      
     'SheetName           - name of sheet in Excel that contains the range or chart to copy 
      
     'PasteChart          -If True then routine will  copy and paste a chart 
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link 
     'ChartNumber         -Chart Object Number 
     ' 
     'PasteRange          - If True then Routine will copy and Paste a range 
     'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values 
     'RangeName           - Address or name of range to copy; "B3:G9" "MyRange" 
     'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide. 
      
     'use active sheet. This can be a direct sheet name 
    SheetName = ActiveSheet.Name 
      
     'Setting PasteRange to True means that Chart Option will not be used 
    PasteRange = True 
     
    RangeName = "RANG1" 
    RangePasteType = "Picture" 
    RangeLink = True 
 
      
    PasteChart = True 
    PasteChartLink = False 
    ChartNumber = 3 
      
    AddSlidesToEnd = True 
      
      
     'Error testing 
    On Error Resume Next 
    Set TestSheet = Sheets(SheetName) 
    Set TestRange = Sheets(SheetName).Range(RangeName) 
    Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber) 
    On Error GoTo 0 
      
    If TestSheet Is Nothing Then 
        MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
      
    If PasteRange And TestRange Is Nothing Then 
        MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
      
    If PasteRange = False And PasteChart And TestChart Is Nothing Then 
        MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
      
      
     'Look for existing instance 
    On Error Resume Next 
    Set PPApp = GetObject(, "PowerPoint.Application") 
    On Error GoTo 0 
      
     'Create new instance if no instance exists 
    PPT.Presentations.Open Filename:="D:\DU Dashboard Template.pptx" 
     'Add a presentation if none exists 
 
      
     'Make the instance visible 
    PPApp.Visible = True 
      
     'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation 
    If PPApp.ActivePresentation.Slides.Count = 0 Then 
         PPT.Presentations.Open Filename:="D:\DU Dashboard Template.pptx" 
 
    Else 
        If AddSlidesToEnd Then 
             'Appends slides to end of presentation and makes last slide active 
            PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
            PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count 
            Set PPSlide = PPApp.ActivePresentation.Slides(PPApp.ActivePresentation.Slides.Count) 
                    'Set the title of the slide the same as the title of the chart 
            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text 
        Else 
             'Sets current slide to active slide 
            Set PPSlide = PPApp.ActiveWindow.View.Slide 
        End If 
    End If 
      
     'Options for Copy & Paste Ranges and Charts 
 
        If RangePasteType = "Picture" Then 
             'Paste Range as Picture 
            Worksheets(SheetName).Range(RangeName).Copy 
 
 
            PPSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select 
                 With PPApp.ActiveWindow.Selection.ShapeRange 
                  
 
.Top = 400 ' points 
.Height = 85 
.Left = 40 
 
 
 End With 
 
        Else 
             'Paste Range as HTML 
            Worksheets(SheetName).Range(RangeName).Copy 
 
            PPSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select 
                With PPApp.ActiveWindow.Selection.ShapeRange 
.Top = 400 ' points 
.Height = 85 
.Left = 40 
 
 
 End With 
 
        End If 
 
         'Options for Copy and Paste Charts 
        Worksheets(SheetName).Activate 
        ActiveSheet.ChartObjects(ChartNumber).Select 
        If PasteChartLink = True Then 
             'Copy & Paste Chart Linked 
            ActiveChart.ChartArea.Copy 
            PPSlide.Shapes.PasteSpecial(link:=False).Select 
        Else 
             'Copy & Paste Chart Not Linked 
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
            PPSlide.Shapes.Paste.Select 
        End If 
 
      
     'Center pasted object in the slide 
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 80 
    PPApp.ActiveWindow.Selection.ShapeRange.Left = 15 
    With PPApp.ActiveWindow.Selection.ShapeRange 
.Top = 90 ' points 
.Left = 100 
.Width = 650 
.Height = 300 
  End With 
    AppActivate ("Microsoft PowerPoint") 
    Set PPSlide = Nothing 
    Set PPApp = Nothing 
Next 
 
End Sub  

But getting the error message as, object variable or block variable not set for the first code I posted. Can anyone please help.

Can you please please help?

[akhileshgs]

Can anyone please help me?