AnimationPoint.Formula-Eigenschaft (PowerPoint)

Zurückgeben oder Festlegen einer Zeichenfolge, die eine Formel zur Berechnung einer Animation darstellt. Lese-/Schreibzugriff.

Syntax

Ausdruck. Formel

Ausdruck Eine Variable, die ein AnimationPoint-Objekt darstellt.

Rückgabewert

Zeichenfolge

Beispiel

Im folgenden Beispiel wird eine Form und dieser eine Füllanimation von drei Sekunden Dauer hinzugefügt.

Sub AddShapeSetAnimFill()

    Dim effBlinds As Effect
    Dim shpRectangle As Shape
    Dim animBlinds As AnimationBehavior

    'Adds rectangle and sets animation effect
    Set shpRectangle = ActivePresentation.Slides(1).Shapes _
        .AddShape(Type:=msoShapeRectangle, Left:=100, _
        Top:=100, Width:=50, Height:=50)

    Set effBlinds = ActivePresentation.Slides(1).TimeLine.MainSequence _
        .AddEffect(Shape:=shpRectangle, effectId:=msoAnimEffectBlinds)

    'Sets the duration of the animation
    effBlinds.Timing.Duration = 3

    'Adds a behavior to the animation
    Set animBlinds = effBlinds.Behaviors.Add(msoAnimTypeProperty)

    'Sets the animation color effect and the formula to use
    With animBlinds.PropertyEffect
        .Property = msoAnimColor
        .Formula = RGB(Red:=255, Green:=255, Blue:=255)
    End With

End Sub

Siehe auch

AnimationPoint-Objekt

Support und Feedback

Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.