注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

自动给ppt加上随机动画效果  

2015-03-20 06:09:07|  分类: office |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
        以前写的一个段小程序,给ppt中的所有文本框加上一段随机动画效果。。。以后看累了再运行一遍,换种效果,VBA绝对是微软继windows和office之后最给了的发明之一。。。进ppt的工具-》宏菜单,创建宏,然后把下面代码拷贝进去,运行一下animation函数就好了,office2003完美运行,其他版本就不知道了,因为我还处在2003的阶段。。享受office automation。。。

Sub animation()
Dim sindex, ssum As Integer
Dim tindex, tsum, ran As Integer
Dim sorder() As Integer
Dim stopp() As Integer
ssum = Application.ActivePresentation.Slides.Count
For sindex = 1 To ssum
     tsum = Application.ActivePresentation.Slides(sindex).Shapes.Count
     ReDim sorder(tsum)
     ReDim stopp(tsum)
     For tindex = 1 To tsum
         sorder(tindex) = tindex
         stopp(tindex) = Application.ActivePresentation.Slides(sindex).Shapes(tindex).Top
     Next
     Call PaiXu(stopp, sorder, True)
     For tindex = 1 To tsum
     With Application.ActivePresentation.Slides(sindex).Shapes(tindex).AnimationSettings
        .Animate = msoTrue
        .TextLevelEffect = ppAnimateByAllLevels
        .AnimateBackground = msoTrue
        .AnimationOrder = sorder(tindex)
        Do
        ran = Int(9 * Rnd)
        Loop Until ran <> 0
         Select Case ran
         Case 1
         .EntryEffect = ppEffectFade
         Case 2
         .EntryEffect = ppEffectBlindsHorizontal
         Case 3
         .EntryEffect = ppEffectCheckerboardAcross
         Case 4
         .EntryEffect = ppEffectDissolve
         Case 5
         .EntryEffect = ppEffectRandomBarsHorizontal
         Case 6
         .EntryEffect = ppEffectFlyFromLeft
         Case 7
         .EntryEffect = ppEffectZoomIn
         Case 8
         .EntryEffect = ppEffectSpiral
         Case 9
         .EntryEffect = ppEffectWipeDown
         End Select
     End With
     Next
Next
End Sub

Sub PaiXu(p() As Integer, o() As Integer, sheng As Boolean)
    Dim i As Integer, j As Integer
    Dim temp As Integer
    Dim m As Integer
    For i = LBound(p) To UBound(p) - 1
    m = i
    For j = i + 1 To UBound(p)
    If sheng Then
    If p(j) < p(m) Then m = j
    Else
    If p(j) > p(m) Then m = j
    End If
    Next j
    If m <> i Then
    temp = p(i)
    p(i) = p(m)
    p(m) = temp
    temp = o(i)
    o(i) = o(m)
    o(m) = temp
    End If
    Next i
End Sub

  评论这张
 
阅读(1480)| 评论(1)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017