请问如何用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)
因为希望动画自行添加并自行播放,所以使用了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
附件

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 编辑 ]
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 编辑 ]
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
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读:74
-
如何安装mysql8.0
阅读:31
-
Word快速设置标题样式步骤详解
阅读:28
-
20+道必知必会的Vue面试题(附答案解析)
阅读:37
-
HTML如何制作表单
阅读:22
-
百词斩可以改天数吗?当然可以,4个步骤轻松修改天数!
阅读:31
-
ET文件格式和XLS格式文件之间如何转化?
阅读:24
-
react和vue的区别及优缺点是什么
阅读:121
-
支付宝人脸识别如何关闭?
阅读:21
-
腾讯微云怎么修改照片或视频备份路径?
阅读:28