向每张幻灯片添加蓝色三角形 - 填充不起作用

Question

我在每张可见的演示幻灯片中添加了一个蓝色小三角形，该三角形在所有其他动画之后消失。这是做演示时的视觉提示，表明我正处于该幻灯片的最后一个动画中。这可以防止我在完成当前幻灯片之前按下遥控器并前进到下一张幻灯片。我尝试使用以下宏：

Sub AddTriangleShape()
    Dim osld As slide
    Dim oSh As Shape

    For Each osld In ActivePresentation.Slides
        If osld.SlideShowTransition.Hidden Then
        Else
            Set oSh = osld.Shapes.AddShape(msoShapeRightTriangle, 947, 529, 6, 6)

            With oSh
                .Line.ForeColor.RGB = RGB(0, 0, 255)
                .Fill.ForeColor.RGB = RGB(0, 0, 255)

                .BlackWhiteMode = msoBlackWhiteDontShow
                .Flip (msoFlipHorizontal)
                .Name = "@END@"
                .AnimationSettings.EntryEffect = ppEffectDissolve
                .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                .AnimationSettings.AdvanceTime = 0
            End With
        End If

    Next osld
End Sub

有两个功能似乎不起作用。纯蓝色填充似乎不起作用，动画窗格中的动画显示三角形应该在最后一个形状动画后自动显示，但幻灯片本身在幻灯片放映模式下会在我更改为滑动。我必须以错误的方式做一些非常简单的事情。有什么提示吗？

Answer 1

如上所述，史蒂夫指出我需要 .Fill.Visible 才能设置前景色。动画部分有点棘手。对形状执行 AnimationSettings 会导致所有类型的问题。我需要声明一个 Effect，然后使用 TimeLine.MainSequence.AddEffect 为有问题的形状设置 osld 上的效果，使用溶解的 effectid，触发器 AfterPrevious 和索引 -1（最后）。完整代码如下所示。这现在对我有用。我首先删除所有现有的@END@ 三角形，然后添加新的@END@ 三角形。这允许我添加更多动画并重新运行宏以将三角形动画放在最后。

Sub AddTriangleShape()
    Dim osld As slide
    Dim oSh As Shape
    Dim oEffect As Effect

    ReDim ShapesToDelete(0)
    Dim ShapeCount

    For Each osld In ActivePresentation.Slides
        If osld.SlideShowTransition.Hidden Then
        Else
            For Each oSh In osld.Shapes
                If oSh.Name Like "@END@" Then

                    ShapeCount = ShapeCount + 1
                    ReDim Preserve ShapesToDelete(0 To ShapeCount)
                    Set ShapesToDelete(ShapeCount) = oSh

                End If
            Next oSh
        End If
    Next osld

    For i = 1 To ShapeCount
        ShapesToDelete(i).Delete
    Next

    For Each osld In ActivePresentation.Slides
        If osld.SlideShowTransition.Hidden Then
        Else

            Set oSh = osld.Shapes.AddShape(msoShapeRightTriangle, 947, 529, 6, 6)

            With oSh
                .Line.ForeColor.RGB = RGB(0, 0, 255)
                .Fill.Visible = msoTrue
                .Fill.ForeColor.RGB = RGB(0, 0, 255)

                .BlackWhiteMode = msoBlackWhiteDontShow
                .Flip (msoFlipHorizontal)
                .Name = "@END@"
            End With

            Set oEffect = osld.TimeLine.MainSequence.AddEffect _
                (Shape:=oSh, effectid:=msoAnimEffectDissolve, trigger:=msoAnimTriggerAfterPrevious, Index:=-1)
        End If

    Next osld
End Sub

向每张幻灯片添加蓝色三角形 - 填充不起作用

Add blue triangle to each slide - fill not working

vba

powerpoint

shape

fill