Copy each excel worksheets and paste in each indivual slides

[Djani]

I have indeed left out this piece of code:

 Set ppSlide = ppPres.Slides(5)

However, this is the 'hard value'. It does work whenever I put this piece of code back into the script, but it doesn't change/manipulate the behavior --> it is set. I want the script to refer to cell B6 since this cell VLOOKUPs the combination of country and model --> returns desired PPT slide. I have left this out, because I can't simply do the following right?

 Set ppSlide = ppPres.Slides(Worksheets("VIVA GRAPH").B6)

Correct me if I'm wrong, but in this case the slide is defined as a cell, which can't ever be the case. I have tried some other things, but it doesn't lead me to a solution. This is what I have:

Sub ChartToPresentation()
         
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim shp As String
Dim newShape As PowerPoint.ShapeRange
Dim rng As Range
Dim cell As Range
Dim i As Integer
i = Worksheets("VIVA GRAPH").Range("PPTSlide")
' Make sure a chart is selected
If ActiveChart Is Nothing Then
    MsgBox "Please select a chart and try again.", vbExclamation, _
        "No Chart Selected"
Else
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    ' Reference active slide
    Set PPSlide = PPPres.Slides(i)
           
    ' Copy chart as a picture
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
        Format:=xlPicture
    ' Paste chart
    Set newShape = PPSlide.Shapes.Paste
With newShape
    .IncrementLeft 400
    .IncrementTop 250
    .ScaleWidth 0.87, msoFalse, msoScaleFromTopLeft
    .ScaleHeight 0.87, msoFalse, msoScaleFromTopLeft
End With
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
End If
End Sub

It gives the error on Set PPSlide = PPPres.Slides(i) --> Integer out of range. 0 is not in the valid range of 1 to 4.

P.S: It is working partially, all numbers above 5 will give the abovementioned error "... valid range of 1 to 5"

[JonPeltier]

Assuming there is a numeric value in cell B6:

Set ppSlide = ppPres.Slides(Worksheets("VIVA GRAPH").Range("B6").Value)

[Djani]

Thanks for the help. I'm not sure if you have seen my last 'editing', but it is partially working --> all numbers above 5 will give the abovementioned error "... valid range of 1 to 5"

When the numeric value in cell B6 is 0 it gives the same error but then ".. valid range of 1 to 50"

Nevermind, I got it to work. I understand the problem --> The PPT itself had less than the number displayed in cell B6 (duhhhhh).

This is the properly working code for any of you interested:

Sub ChartToPresentation()
         
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim shp As String
Dim newShape As PowerPoint.ShapeRange
Dim rng As Range
Dim cell As Range
Dim x As Integer
x = Worksheets("VIVA GRAPH").Range("PPTSlide")
' Make sure a chart is selected
If ActiveChart Is Nothing Then
    MsgBox "Please select a chart and try again.", vbExclamation, _
        "No Chart Selected"
Else
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    ' Reference active slide
   Set PPSlide = PPPres.Slides(Worksheets("VIVA GRAPH").Range("B6").Value)
           
    ' Copy chart as a picture
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
        Format:=xlPicture
    ' Paste chart
    Set newShape = PPSlide.Shapes.Paste
    'Resize chart'
    With newShape
        .IncrementLeft 400
        .IncrementTop 250
        .ScaleWidth 0.87, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.87, msoFalse, msoScaleFromTopLeft
    End With
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
End If
End Sub

Thanks for sharing your expertise Jo(h)n, really appreciate it.

[JonPeltier]

"... valid range of 1 to 5"
"... valid range of 1 to 50"

Where do these come from? Those are not in the error messages.

In any case, your code has to make sure the input is valid, and warn the user if it is not.

[Djani]

It's a dumb mistake. The macro is working properly, but the presentation that was open had f.e. 4 slides in TOTAL while referring to cell B6. Any number above 4 gave this error. It was simply solved by creating additional slides in the PowerPoint itself.

I have changed the script a little bit. Instead of clicking on the chart, the user can click on a CommandButton (refers to active chart in worksheet) and automatically put the chart in the desired PPT slide. However, there can only be ONE POSSIBLE SCENARIO that will give an error like this --> if the variable (combination of country and model) is not defined. This will always give a 0 unless defined of course.

So instead of having the message "Please select a chart and try again." I was thinking of having a message "Please define combination in sheet Variable".
It's not working though!

  

 Private Sub CommandButton2_Click()
 Dim PPApp As PowerPoint.Application
 Dim PPPres As PowerPoint.Presentation
 Dim PPSlide As PowerPoint.Slide
 Dim shp As String
 Dim newShape As PowerPoint.ShapeRange
 Dim rng As Range
 Dim cell As Range
 Dim x As Integer
 x = Worksheets("VIVA GRAPH").Range("PPTSlide")
 If x Is Nothing Then
  MsgBox "Please define combination in sheet Variable"
  
 Else
  
     ' Make sure a chart is selected
     ActiveSheet.ChartObjects("Chart 5").Activate

     ' Reference existing instance of PowerPoint
     Set PPApp = GetObject(, "Powerpoint.Application")
     ' Reference active presentation
     Set PPPres = PPApp.ActivePresentation
     ' Reference active slide
    Set PPSlide = PPPres.Slides(Worksheets("VIVA GRAPH").Range("B6").Value)
            
     ' Copy chart as a picture
     ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
         Format:=xlPicture
     ' Paste chart
     Set newShape = PPSlide.Shapes.Paste
     'Resize chart'
     With newShape
         .IncrementLeft 400
         .IncrementTop 250
         .ScaleWidth 0.87, msoFalse, msoScaleFromTopLeft
         .ScaleHeight 0.87, msoFalse, msoScaleFromTopLeft
     End With
     ' Clean up
     Set PPSlide = Nothing
     Set PPPres = Nothing
     Set PPApp = Nothing
 End If

 End Sub

It gives an error at "If x Is Nothing Then".

Thanks again for sharing your expertise.

[Djani]

Rookie mistakes, sorry for that. Changed "If x Is Nothing Then" to "If x = 0 Then" and this works perfectly fine.

[JonPeltier]

An object variable can be Nothing, a numeric variable cannot, so the If makes no sense.

Try this modification:

Dim x As Long  '' Longs are preferable to Integers
x = Worksheets("VIVA GRAPH").Range("PPTSlide").Value  '' Use .Value, don't rely on default properties
If x > 0 and x < 5 Then  '' explicitly set limits

[Djani]

It's working perfect. However, I believe should also work fine:

If x = 0 Then

Yours sincerely,

Djani

[JonPeltier]

What you said earlier indicated you need upper and lower limits.

[Djani]

I understand, thanks again for everything. Last question. I have a properly working VBA script that removes all charts/tables in the whole presentation. However, it's missing a loop hence the reason I have to click on the macro several times to have all tables/charts removed. How can I integrate a loop in the following VBA script?

Sub DeleteAllGraphs()
    Dim objApp, objSlide, ObjShp, objTable
    On Error Resume Next
    Set objApp = CreateObject("PowerPoint.Application")
    On Error GoTo 0
    For Each objSlide In objApp.ActivePresentation.Slides
        For Each ObjShp In objSlide.Shapes
            If ObjShp.Type = msoPicture Then ObjShp.Delete
                For Each objTable In objSlide.Shapes
                    If objTable.Type = msoTable Then objTable.Delete
        Next
    Next
Next
End Sub

[JonPeltier]

Use the same construction for all shapes. You have enough loops, too many even, since you're looking for tables within the shapes loop.

        For Each ObjShp In objSlide.Shapes
             If ObjShp.Type = msoPicture Then 
                ObjShp.Delete 
            ElseIf ObjShp.Type = msoTable Then 
                ObjShp.Delete
            End If
        Next