能帮忙写一个可以显示时间的VBA吗？在野党感谢

hseflyi

在网上找了一下，全是插入flash的。希望可以是写成VBA的，在PPT播放时，自动显示时间。
请教大家了，非常感谢！

YZLSZAJ

请将excel文件压缩后上传。

kxs5555

好像是要在PPT上吧

lss001

Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, ByVal uElaspe As Long, ByVal lpTimerFunc As Long) As Long
Declare PtrSafe Function KillTimer Lib "user32" _
    (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Dim MyTimer As Long, ds() As Object, m, n
Sub sTimer() '显示时间
    m = ActivePresentation.Slides.Count
    l = ActivePresentation.Slides.Application.Width
    ReDim ds(1 To m)
    For i = 1 To m
        x = 0
        For Each da In ActivePresentation.Slides(i).Shapes
            If da.Name = "TextBox 1" Or da.Name = "文本框 1" Then
                Set ds(i) = da: ds(i).TextFrame.TextRange.Text = "": x = 1
            End If
        Next
        If x = 0 Then
            Set ds(i) = ActivePresentation.Slides(i).Shapes.AddTextbox(1, l / 2 - 125, 0, 250, 50)
            ds(i).TextFrame.TextRange.Font.Color = RGB(0, 0, 255)
        End If
    Next
    MyTimer = SetTimer(0, 0, 1000, AddressOf sNow): n = 1
End Sub
Sub sNow(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
    If n = 1 Then
        For i = 1 To m
            sj = Format(Now, "yyyy/mm/dd hh:mm:ss")
            ds(i).TextFrame.TextRange.Text = sj
        Next
    Else: KillTimer 0, MyTimer
    End If
    DoEvents
End Sub
Sub nStop() '停止显示
    n = 0
End Sub

dongdonggege

lss001 发表于 2020-3-20 13:23
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, B ...

感觉，你的函数格式好像不对。
你看以下两个图片，哪个正确？

dongdonggege

lss001 发表于 2020-3-20 13:23
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, B ...

放在一起比较。

dongdonggege

lss001 发表于 2020-3-20 13:23
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, B ...

sj = Format(Now, "yyyy年M月d日  hh:mm:ss")
这样行吗？感觉没错。
如果分两行，一行日期，一行时间，怎样写？

dongdonggege

lss001 发表于 2020-3-20 13:23
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, B ...

另外发个求助，怎么插入这样的ppt艺术字，字号，字体，字形，格式，要求一样一样的。
能读出来吗？而且好像是动画一样。
如果在原来的基础上修改没用处，我想有这样的程序，在别的ppt页能插入这样的艺术字，谢谢。