Access/VBA Library


Gets the current shape and duplicates it for every element in the Content parameter and adds animations to show one shape at a time. Animations are trigger by mouse-click as default but also a timer can be set.

This function is usefull for creating a slide containing more text than a shape can hold or to create a countdown timer.


PopulateTextShape( Content [, SetTimer] [, TimerDelayTime] )
Name Type Description
Content Variant Required. An Array containing the text to populate.
SetTimer Boolean Optional. Indicates if shapes should be animated on timer (when True) or mouse-click (when False).
Default: False
TimerDelayTime Long Optional. The delaytime for the animations when SetTimer is set to True.
Default: 1
Public Sub PopulateTextShape(Content, _
                               Optional ByVal SetTimer As Boolean = False, _
                               Optional ByVal TimerDelayTime As Long = 1)

    Dim Index As Long
    Dim CurrentShape As Shape
    Dim NewShape As Shape
    Dim PrevShape As Shape
    Dim DummyShape As Shape
    ' Check if there is an active shape and text is passed
    If ActiveShape Is Nothing Then Exit Sub
    If Not IsArray(Content) Then Exit Sub
    If UBound(Content) = -1 Then Exit Sub
    ' Initialisations
    Set CurrentShape = ActiveShape
    Set PrevShape = ActiveShape
    Set DummyShape = CurrentShape.Duplicate(1)
    ' Fill currentshape with first content
    Index = LBound(Content)
    CurrentShape.TextFrame.TextRange.Text = Content(Index)
    For Index = LBound(Content) + 1 To UBound(Content)
        ' Create a new shape based on the current one
        Set NewShape = DummyShape.Duplicate(1)
        With NewShape
            .name = & "_" & Index
            .TextFrame.TextRange.Text = Content(Index)
            .Top = CurrentShape.Top
            .Left = CurrentShape.Left
        End With
        ' Add animations
        With ActiveSlide.TimeLine.MainSequence
            If SetTimer Then
                ' Add timer of 1 second
                With .AddEffect(NewShape, msoAnimEffectAppear, , msoAnimTriggerAfterPrevious)
                    .Timing.TriggerDelayTime = TimerDelayTime
                End With
                ' No timer then animate on mouse-click
                .AddEffect NewShape, msoAnimEffectAppear, , msoAnimTriggerOnPageClick
            End If
            ' When NewShape will appear, then the previous one must be hidden by an exit effect
            With .AddEffect(PrevShape, msoAnimEffectAppear, , msoAnimTriggerAfterPrevious)
                If SetTimer Then .Timing.TriggerDelayTime = 0
                .Exit = msoCTrue
            End With
        End With
        ' Save reference to new shape to add Exit effect to
        Set PrevShape = NewShape
    Next Index
End Sub



  • There should be one shape active when executing this function.

See also

  • PopulateTextShape_Example