Vba 为每张幻灯片添加蓝色三角形-填充无效

Vba 为每张幻灯片添加蓝色三角形-填充无效,vba,powerpoint,shape,fill,Vba,Powerpoint,Shape,Fill,我将一个小的蓝色三角形添加到我的每个可见演示幻灯片中,这些幻灯片在所有其他动画之后都会消失。这是演示时的一个视觉提示,表明我在该幻灯片的最后一个动画中。这可以防止我在完成当前幻灯片之前点击遥控器并进入下一张幻灯片。 我尝试使用以下宏: Sub AddTriangleShape() Dim osld As slide Dim oSh As Shape For Each osld In ActivePresentation.Slides If osld.Sl

我将一个小的蓝色三角形添加到我的每个可见演示幻灯片中,这些幻灯片在所有其他动画之后都会消失。这是演示时的一个视觉提示,表明我在该幻灯片的最后一个动画中。这可以防止我在完成当前幻灯片之前点击遥控器并进入下一张幻灯片。 我尝试使用以下宏:

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

有两种功能似乎不起作用。蓝色实心填充似乎不起作用,“动画”窗格中的动画显示三角形应在上次形状动画之后自动显示,但幻灯片放映模式中的幻灯片本身在我切换到幻灯片后立即显示三角形。我一定是用错误的方式做了一些非常简单的事情。有什么提示吗?

如上所述,Steve指出在设置前景色之前我需要.Fill.Visible。动画部分有点棘手。在形状上执行动画设置会导致所有类型的问题。我需要声明一个效果,然后使用TimeLine.MainSequence.AddEffect为所讨论的形状设置osld上的效果,使用已溶解的effectid,使用trigger AfterPrevious和索引-1(last)。完整代码如下所示。这对我来说很有效。 我首先删除所有现有的@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

关于未显示的填充,请在设置填充颜色之前添加.fill.Visible。与往常一样,Steve Rindsberg提供了大量信息来解决部分问题。谢谢你,史蒂夫!完整的解决方案如下所示。哇!动画方面做得不错,克里夫。非常令人印象深刻。谢谢你,史蒂夫。来自大师的高度赞扬!主人不,我只是在网上玩一个。哦,顺便说一句,请不要把我对链接邀请的不回应当成是我个人的事。我几乎从来没有注意过。。。也许应该删除这个账户。