locked
Get only selected graphs on one PowerPoint slide from different sheets van Excel VBA RRS feed

  • Question

  • Hi,

    I have the following code:

    Sub CreatePowerPoint()
     
         'First we declare the variables we will be using
            Dim newPowerPoint As PowerPoint.Application
            Dim activeSlide As PowerPoint.Slide
            Dim cht As Excel.ChartObject
         
         'Look for existing instance
            On Error Resume Next
            Set newPowerPoint = GetObject(, "PowerPoint.Application")
            On Error GoTo 0
         
        'Let's create a new PowerPoint
            If newPowerPoint Is Nothing Then
                Set newPowerPoint = New PowerPoint.Application
            End If
        'Make a presentation in PowerPoint
            If newPowerPoint.Presentations.Count = 0 Then
                newPowerPoint.Presentations.Add
            End If
         
        'Show the PowerPoint
            newPowerPoint.Visible = True
        
        'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
            For Each cht In ActiveSheet.ChartObjects
            
            'Add a new slide where we will paste the chart
                newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
                newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
                Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
                    
            'Copy the chart and paste it into the PowerPoint as a Metafile Picture
                cht.Select
                ActiveChart.ChartArea.Copy
                activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
        
        ' Set a reference to the Excel workbook and sheet
                Set WB = Workbooks(1)
                Set WS1 = WB.Worksheets(1)
                Set WS2 = WB.Worksheets(2)
                Set WS3 = WB.Worksheets(3)
                Set WS4 = WB.Worksheets(4)
                Set WS5 = WB.Worksheets(5)
                Set WS6 = WB.Worksheets(6)
      
            'Set the title of the slide the same as the title of the chart
                SlideTextTitle = "B73N - ODI #" & WS6.Cells(11, 2) & " - RI #" & WS6.Cells(12, 2) & " - ATA " & WS6.Cells(3, 2) & " - " & WS6.Cells(13, 3)
                SlideTextText = WS6.Cells(14, 3)
                activeSlide.Shapes(1).TextFrame.TextRange.Text = SlideTextTitle
                activeSlide.Shapes(2).TextFrame.TextRange.Text = SlideTextText
                
            'Set text font
                activeSlide.Shapes(1).TextFrame.TextRange.Font.Name = "Verdana (Headings)"
                activeSlide.Shapes(1).TextFrame.TextRange.Font.Size = 20
                activeSlide.Shapes(1).TextFrame.TextRange.Font.Bold = True
                activeSlide.Shapes(1).TextFrame.TextRange.Font.Color.RGB = RGB(0, 155, 225)
                
                activeSlide.Shapes(2).TextFrame.TextRange.Font.Name = "Verdana (Body)"
                activeSlide.Shapes(2).TextFrame.TextRange.Font.Size = 11
                activeSlide.Shapes(2).TextFrame.TextRange.Font.Underline = True
                activeSlide.Shapes(2).TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 125)
                activeSlide.Shapes(2).TextFrame.TextRange.ParagraphFormat.Bullet.Visible = False
                
            'Adjust the positioning of the Chart on Powerpoint Slide
                newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 420
                newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 100
                newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 300
            
                activeSlide.Shapes(1).Top = 0
                activeSlide.Shapes(1).Width = 720
                activeSlide.Shapes(1).Left = 0
                
                activeSlide.Shapes(2).Width = 500
                activeSlide.Shapes(2).Left = 0
                
            Next
         
        AppActivate ("Microsoft PowerPoint")
        Set activeSlide = Nothing
        Set newPowerPoint = Nothing
         
    End Sub
    

    This is a test file.

    This makes sure that the graph in sheet1 and text in sheet1 will be copied to a powerpoint slide and it works.

    There are several things that I want for the official file, but I can not find out how.

    1) There are graphs spread over the different sheets. How can I program that Excel only gets the graphs from a specific sheet? 

    2) If 1) works, how can I program that Excel does not copy all of the graphs in that sheet, but only the ones I select?

    I hope someone could help me.

    Thanks!


    Thursday, October 13, 2016 7:28 AM

Answers

  • In that situation, what code are you using now?

    To avoid confusion which might cause from ActiveSheet, I would suggest you use something like:

        Sheets("Sheet1").ChartObjects("Chart 1").Activate

        ActiveChart.ChartArea.Copy

    • Marked as answer by ganeshgebhard Wednesday, October 19, 2016 12:45 PM
    Wednesday, October 19, 2016 11:50 AM

All replies

  • >>There are graphs spread over the different sheets. How can I program that Excel only gets the graphs from a specific sheet?

    You could use WB.Worksheets("name") to refer to the specific sheet, like WB.Worksheets("Sheet1")

     

    >>how can I program that Excel does not copy all of the graphs in that sheet, but only the ones I select?

    Similarly, you could use name of the chartobject like ActiveSheet.ChartObjects("Chart 2")  to determine if you want to copy instead of using For Each statement.

    E.g.

        ActiveSheet.ChartObjects("Chart 2").Activate

        ActiveChart.ChartArea.Copy

     

    Thursday, October 13, 2016 10:43 AM
  • Try incorporating below logic in your code.

    1 ) This will ask user to enter sheet by an input box

    2 ) You have to select the Graphs before running. Below will activate the sheet entered by user and copy the chart selected.

    '****Added************************************ 'Keep the chart selected before running. 'Unfortunately VBA's inputbox allows selection of range. 'Were it allowed, it would have been better. Dim sSheet As String Dim k As Long Dim vIt As Variant sSheet = Application.InputBox(prompt:="Pls enter sheetname") Worksheets(sSheet).Activate On Error Resume Next Err.Clear k = Selection.Count

    on error goto 0 If Err.Number > 0 Then If TypeName(Selection) Like "Chart*" Then Set vIt = Selection 'Add a new slide where we will paste the chart newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count) 'Copy the chart and paste it into the PowerPoint as a Metafile Picture vIt.Copy 'ActiveChart.ChartArea.Copy activeSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture End If Else 'Loop through each chart in the Excel worksheet and paste them into the PowerPoint For Each vIt In Selection If TypeName(vIt) Like "Chart*" Then 'Add a new slide where we will paste the chart newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count) 'Copy the chart and paste it into the PowerPoint as a Metafile Picture vIt.Copy activeSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture End If Next vIt End If



    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    Thursday, October 13, 2016 7:13 PM
    Answerer
  • Thanks.

    I get an error code with: ActiveSheet.ChartObjects("D0 Performance").Activate

    'The item with the specified name wasn't found.'


    Friday, October 14, 2016 8:18 AM
  • What I have given is bare skeleton focused on input specification. First try above code, if you are able to get the selected chart on power then go for incorporating into main code.

    Further the above line is not in my code or your code. If updated pls share that code.

    The above error can happen if the named chart is not available. But in my code i just looped over selection and copied.

    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    Friday, October 14, 2016 10:34 AM
    Answerer
  • Hi,

    Do you try the code Asadulla shared? Does it work for you?

    According to the error, I suggest you check the name of the chart.

    If you don’t know its name, you could use the code below to output the name.

    Dim a As ChartObject
    
    For Each a In ActiveSheet.ChartObjects
    
    Debug.Print a.Name  'MsgBox a.Name
    
    Next
    

    Tuesday, October 18, 2016 8:07 AM
  • No that also doesn't work.

    The names of the Charts have not been changed, so chart 1, chart 2, etc... are still the names.

    Tuesday, October 18, 2016 8:25 AM
  • Since we could not reproduce your issue without your data, could you please share a sample file with us for testing?

    According to your previous post and the error with line ActiveSheet.ChartObjects("D0 Performance").Activate, it seems that you are using the title of the chart.

    Tuesday, October 18, 2016 4:53 PM
  • Sorry but no, the file has information that I can not share.
    Tuesday, October 18, 2016 6:24 PM
  • In that situation, what code are you using now?

    To avoid confusion which might cause from ActiveSheet, I would suggest you use something like:

        Sheets("Sheet1").ChartObjects("Chart 1").Activate

        ActiveChart.ChartArea.Copy

    • Marked as answer by ganeshgebhard Wednesday, October 19, 2016 12:45 PM
    Wednesday, October 19, 2016 11:50 AM
  • That did the magic! Thanks!
    Wednesday, October 19, 2016 12:45 PM