Consulting

Results 1 to 9 of 9

Thread: Trigger animation delay to 2nd animation also in a shape using powerpoint vba

  1. #1

    Trigger animation delay to 2nd animation also in a shape using powerpoint vba

    Sir I need help for simple code which I can not configure.


    I have rectangular shape(say Rectangle1) with two different animations ie motion path(Right) & grow/shrink.
    I want to add another rectangular shape(say Rectangle2) same as Rectangle1 with shape & animation but want to give animation delay
    4 seconds to 1st animation(motion path),5 second to 2nd animation(grow/shrink).
    I tried the code below it only give animation delay to motion path. But how I configure for other [2nd animation(grow/shrink)].
    Sub addAnnimation()


    Dim oeff As Effect


    Dim t As Long


    Dim l As Long


    Dim h As Long


    Dim w As Long


    Dim shp As Shape


    Dim recnewShp As Shape


    On Error Resume Next




    Set shp = Application.Presentations(1).Slides(1).Shapes("Rectangle1")


    If shp Is Nothing Then GoTo err


    shp.PickupAnimation


    shp.PickUp


    'Capture properties of exisitng Rectangle1 such as location and size


    With shp


    t = .Top


    l = .Left


    h = .Height


    w = .Width


    End With


    Set recnewShp = Application.Presentations(1).Slides(1).Shapes.AddShape(shp.AutoShapeType, l, t, w, h)


    recnewShp.Apply


    recnewShp.ApplyAnimation


    Set oeff = Application.Presentations(1).Slides(1).TimeLine.MainSequence.FindFirstAnima tionFor(recnewShp)


    oeff.Timing.TriggerDelayTime = 4


    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious




    recnewShp.Name = "Rectangle2"


    Exit Sub


    err:


    MsgBox "Error, please select a shape."


    End Sub

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,943
    Location
    This seems to be a duplicate of the post here except the number of animations is different. Since the number matters please sort out which you need.
    https://answers.microsoft.com/en-us/...0-2a39f587e42e
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    Thanks Sir for your attention.
    I cannot configure the logic how to give animation delay to other than first animation of a shape(having 3 animation).
    Sir please help to configure https://answers.microsoft.com/en-us/...0-2a39f587e42e

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,943
    Location
    Quote Originally Posted by dibyendu2280 View Post
    Thanks Sir for your attention.
    I cannot configure the logic how to give animation delay to other than first animation of a shape(having 3 animation).
    Sir please help to configure https://answers.microsoft.com/en-us/...0-2a39f587e42e
    Try

    Sub addAnnimation()
    Dim oeff As Effect
    Dim C As Long
    Dim X As Long
    Dim t As Long
    Dim l As Long
    Dim h As Long
    Dim w As Long
    Dim shp As Shape
    Dim osld As Slide
    Dim recnewShp As Shape
    On Error Resume Next
    Set osld = ActivePresentation.Slides(1)
    Set shp = osld.Shapes("Rectangle 1")
    shp.PickupAnimation
    shp.PickUp
    'Capture properties of exisitng Rectangle1 such as location and size
    With shp
    t = .Top
    l = .Left
    h = .Height
    w = .Width
    End With
    Set recnewShp = osld.Shapes.AddShape(shp.AutoShapeType, l, t, w, h)
    recnewShp.Apply
    recnewShp.ApplyAnimation
    For C = 1 To osld.TimeLine.MainSequence.Count
    If osld.TimeLine.MainSequence(C).Shape.Id = recnewShp.Id Then
    X = X + 1
    Set oeff = osld.TimeLine.MainSequence(C)
    Select Case X
    Case Is = 1
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = 4
    Case Is = 2
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = 5
    Case Is = 3
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = 6
    End Select
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    recnewShp.Name = "Rectangle 2"
    End If
    Next C
    End Sub
    Make sure the shape is named Rectangle 1.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  5. #5
    Thanks Sir. Shape animation works perfectly as i wanted.
    When i apply for more shape through loop it generate only one shape(ie pentagon6) but animation works perfectly.I want to generate & apply for another 15 shape. so where i do wrong?

    Sub addAnnimation()
    Dim oeff As Effect
    Dim C As Long
    Dim j As Long
    Dim X As Long
    Dim t As Long
    Dim l As Long
    Dim h As Long
    Dim w As Long
    Dim shp As Shape
    Dim osld As Slide
    Dim recnewShp As Shape
    On Error Resume Next
    Set osld = ActivePresentation.Slides(2)
    For j = 5 To 20 'want to create 15 more shape like pentagon5 (ie pentagon6,pentagon7,......pentagon20)
    Set shp = osld.Shapes("pentagon" & j)
    shp.PickupAnimation
    shp.PickUp
    'Capture properties of exisitng Rectangle1 such as location and size
    With shp
    t = .Top
    l = .Left
    h = .Height
    w = .Width
    End With
    Set recnewShp = osld.Shapes.AddShape(shp.AutoShapeType, l, t, w, h)
    If shp.HasTextFrame Then
    recnewShp.TextFrame.TextRange = shp.TextFrame.TextRange

    End If
    recnewShp.Apply
    recnewShp.ApplyAnimation
    For C = 1 To osld.TimeLine.MainSequence.Count
    If osld.TimeLine.MainSequence(C).Shape.Id = recnewShp.Id Then
    X = X + 1
    Set oeff = osld.TimeLine.MainSequence(C)
    Select Case X
    Case Is = 1
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = (j - 4) * 4.5
    Case Is = 2
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = (j - 3) * 4.5
    Case Is = 3
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = (j - 3) * 4.5
    Case Is = 4
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = (j - 2) * 4.5
    Case Is = 5
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    oeff.Timing.TriggerDelayTime = (j - 1) * 4.5
    End Select
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    recnewShp.Name = "pentagon" & j + 1
    End If
    Next C
    Next j
    End Sub
    Last edited by dibyendu2280; 09-06-2020 at 01:21 PM.

  6. #6
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,943
    Location
    Yet again you have got the answer only to ask yet another different version of the question. This time I will let you work it out for yourself.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  7. #7
    Sir I apologize for my mistake.
    I cannot configure the animation portion of the code that's why I asking about that portion only.You configure animation portion perfectly but when I add to main code it added all shapes(shows in animation pane & selection pane) with same animation delay & displaying only one shape(ie pentagon6) with animation.
    Sir please help.
    Last edited by dibyendu2280; 09-06-2020 at 02:53 PM.

  8. #8
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,943
    Location
    Hints then


    Always copy position etc from the first shape (pentagon 5?)
    Set shp = osld.Shapes("pentagon 5" )

    After each loop of C you need to reset X to zero I think
    Next X=0
    Next j
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  9. #9
    Thanks Sir.Now its works as I want.You are a genius & master of powerpoint vba.I have no word how to appreciate you. You save me lot of time.Thanks again sir.

Tags for this Thread

Posting Permissions

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