Consulting

Page 4 of 4 FirstFirst ... 2 3 4
Results 61 to 71 of 71

Thread: Copy each excel worksheets and paste in each indivual slides

  1. #61
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    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"
    Last edited by Djani; 03-22-2016 at 07:21 AM. Reason: tested

  2. #62
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Assuming there is a numeric value in cell B6:

    Set ppSlide = ppPres.Slides(Worksheets("VIVA GRAPH").Range("B6").Value)
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  3. #63
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    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.
    Last edited by Djani; 03-22-2016 at 07:42 AM. Reason: tested

  4. #64
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    "... 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.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  5. #65
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    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.
    Last edited by Djani; 03-22-2016 at 08:02 AM. Reason: change

  6. #66
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Rookie mistakes, sorry for that. Changed "If x Is Nothing Then" to "If x = 0 Then" and this works perfectly fine.
    Last edited by Djani; 03-22-2016 at 08:21 AM. Reason: solution found

  7. #67
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    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
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  8. #68
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    It's working perfect. However, I believe should also work fine:

    If x = 0 Then
    Yours sincerely,

    Djani

  9. #69
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    What you said earlier indicated you need upper and lower limits.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  10. #70
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    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

  11. #71
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    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
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •