+ -
当前位置:首页 → 问答吧 → 请问如何用VBA更改动画文本按字母延时百分比

请问如何用VBA更改动画文本按字母延时百分比

时间:2011-03-03

来源:互联网

在没有调整的情况下,vba生成的动画的字母延时是100延时,我希望只有10延时。请问VBA中应该怎么写呢?
因为希望动画自行添加并自行播放,所以使用了ANIMATIONSETTINGS,而没有使用addeffect。现在的vba代码如下:
Sub a1()
Dim doc As Slide, a As Variant, shp As Shape, text1$,  shp_t As Variant
Set doc = ActivePresentation.Slides(1)
For Each a In doc.Shapes
a.Delete
Next
Set shp = doc.Shapes.AddShape(msoShapeRoundedRectangle, 10, 25, 200,100)
shp.Name = "3101"
shp.Line.Visible = msoFalse
shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
text1 = "3101 B2051"
Set shp_t = shp.TextFrame2.TextRange
shp_t.Text = text1
shp_t.Font.Size = 24
shp_t.Font.Name = "Verdana"

With shp.AnimationSettings
    .AdvanceMode = ppAdvanceOnTime
    .AdvanceTime = 0
    .EntryEffect = ppEffectSwivel
    .TextLevelEffect = ppAnimateByFirstLevel
    .TextUnitEffect = ppAnimateByCharacter
    .Animate = msoTrue
End With
End Sub

附件

无标题.jpg(25.89 KB)

2011-3-3 08:20

作者: gostnort   发布时间: 2011-03-03

动画效果很不错,但要正常运行好象要修改Set shp_t = shp.TextFrame2.TextRange
Sub a1()
Dim doc As Slide, a As Variant, shp As Shape, text1$,  shp_t As Variant
Set doc = ActivePresentation.Slides(1)
For Each a In doc.Shapes
a.Delete
Next
Set shp = doc.Shapes.AddShape(msoShapeRoundedRectangle, 10, 25, 200,100)
shp.Name = "3101"
shp.Line.Visible = msoFalse
shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
text1 = "3101 B2051"

Set shp_t = shp.TextFrame.TextRange

shp_t.Text = text1
shp_t.Font.Size = 24
shp_t.Font.Name = "Verdana"

With shp.AnimationSettings
    .AdvanceMode = ppAdvanceOnTime
    .AdvanceTime = 0
    .EntryEffect = ppEffectSwivel
    .TextLevelEffect = ppAnimateByFirstLevel
    .TextUnitEffect = ppAnimateByCharacter
    .Animate = msoTrue
End With
End Sub

[ 本帖最后由 chuhaiou 于 2011-3-3 09:59 编辑 ]

作者: chuhaiou   发布时间: 2011-03-03

可能2010的代码和以前的有点不同吧。
继续求助中……

作者: gostnort   发布时间: 2011-03-03

变通处理啊,vba中如果实在找不出字符延时的属性或方法的话,可以通过改变动画的速度来间接实现。我改写你这个代码如下:

Sub charEff()
    Dim iSld As Slide, allShp As Shape, newShp As Shape
    Randomize
    Set iSld = ActiveWindow.Selection.SlideRange(1)
    For i = iSld.Shapes.Count To 1 Step -1
        iSld.Shapes(i).Delete
    Next
    Set newShp = iSld.Shapes.AddShape(msoShapeRoundedRectangle, 10, 25, 200, 100)
    With newShp
        .Name = "3101"
        .Line.Visible = msoFalse
        .Fill.ForeColor.SchemeColor = ppForeground
        .Fill.Visible = msoFalse
        With .TextFrame.TextRange
            .Text = "3101 B2051"
            .Font.Size = 24
            .Font.Name = "Verdana"
            For i = 1 To Len(.Text)
                .Characters(i, 1).Font.Color.RGB = 16777216 * Rnd
            Next
        End With
    End With
    With newShp.AnimationSettings
        .AdvanceMode = ppAdvanceOnTime
        .AdvanceTime = 0
        .EntryEffect = ppEffectSwivel
        .TextLevelEffect = ppAnimateByFirstLevel
        .TextUnitEffect = ppAnimateByCharacter
        .Animate = msoTrue
    End With
    With iSld.TimeLine.MainSequence(1).Timing
        .Duration = 0.25
        .RepeatCount = 9999
        .Decelerate = 0.1
    End With
End Sub

[ 本帖最后由 laose 于 2011-3-3 13:45 编辑 ]

作者: laose   发布时间: 2011-03-03

感谢3楼的提点。在3楼的基础上做了些实验。虽然可以通过缩短时间来完成在固定时间内播放完动画。但不能做到前一个字母动画还没有完成的时候,下一个就已经开始。那种连续的变化和跳动的感觉似乎只能改变那个数字才可以。

作者: gostnort   发布时间: 2011-03-03

是的。手工修改下岂不是很简单。vba动画和常规动画在实现手段上不尽相同,取长补短吧。

作者: laose   发布时间: 2011-03-03