如何在ppt中制作一个从1到1000的数字递增效果，最后停留在1000

mazhiq

大神们，如何在ppt中制作一个从1到1000的数字递增效果，最后停留在1000。实在是不会做，请会的大神教教我！！！！

weiyingde

帮你做好了，你试试看吧。可以的话，赏朵小花。

weiyingde

附件见下面。

Sean_zhang810

weiyingde 发表于 2019-10-10 19:44
附件见下面。

大神，能不能帮忙修改下，每隔24小时，再更新一次，比如晚上12点之后，3变成4，第二天晚上12点之后再变成5，最好可以从系统取时间，而不是打开点击按钮之后，才刷新。我们希望可以按系统时间，每增加一天，就增加1.

weiyingde

Sean_zhang810 发表于 2019-10-29 14:20
大神，能不能帮忙修改下，每隔24小时，再更新一次，比如晚上12点之后，3变成4，第二天晚上12点之后再变成 ...

仍然可以用循环，只不过数字更新的时间更长，要24小时，86400秒，不易测试效果，可将86400改成60秒，看看效果。
代码如下：
Private Sub CommandButton1_Click()
Dim shp As Shape, i%
'On Error Resume Next
With ActivePresentation.SlideShowWindow.View.Slide
     With .Shapes("数字")
           For i = 1 To 1000
               .Fill.BackColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
               With .TextFrame.TextRange
                    .Font.Name = Array("宋体", "楷体", "Arial Black", "Arial Narrow")(Int(Rnd * 4))
                    .Text = N
                    .Font.Size = 140
                    .Font.Bold = True
                    .Font.Color.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
               End With
                  tm1 = Timer
                  Do
                     DoEvents
                  Loop While Timer - tm1 < 5
                  If i = 1000 Then MsgBox "时间到！", vbCritical, Space(12) + "提示"
                  N = N + 1
           Next
     End With
End With
End Sub

weiyingde

附件见下，请查阅。

Sean_zhang810

weiyingde 发表于 2019-10-30 12:17
附件见下，请查阅。

是的，在你的程序了，可以更改间隔时间的。 再麻烦一下，可否改成从系统时间加1，比如起始时间是October-20-2019， 对应数字是278， 等系统时间到了10月21号，变成279. 麻烦了，麻烦了，工作真需要这个，不然每天要去手改，再到外面的显示器上. 显示器上有系统时间的。

weiyingde

Sean_zhang810 发表于 2019-10-31 08:10
是的，在你的程序了，可以更改间隔时间的。 再麻烦一下，可否改成从系统时间加1，比如起始时间是October- ...

可以实现，不用循环。
新建一模块

sub onslideshowpagechang()
  earlertime = DateSerial(2019, 10, 20)
  n = Int(Now() - earlertime) + 279 - 1
  ActivePresentation.Slides(1).Shapes("数字").TextFrame.TextRange.Text = n

end sub

Sean_zhang810

weiyingde 发表于 2019-10-31 09:47
可以实现，不用循环。
新建一模块

大哥，可以麻烦做到PPT里吗？ 我完全外行，不知道怎么办啊！   非常非常感谢！

weiyingde

在新建的ppt（注意：在ppt2003或2010中）写入如下代码，应该是可以实现的。