32位系统的代码如何在64位系统上运行？

474489459

以下代码在32系统上运行良好，但在64位系统上就运行不畅，请教如何修改？太折腾人了，想哭，求救。。。。。。

'申明API函数
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private TimerID As Long

Public WithEvents thisApp As Application

Private Sub thisApp_SlideShowBegin(ByVal Wn As SlideShowWindow)
    Dim prompt As String
    prompt = " 演讲时间默认30分钟，最长300分钟。" _
    & vbCrLf _
    & vbCrLf & " 演讲者自行修改时间，按确定键开始计时！" _
    & vbCrLf _
    & vbCrLf & " 邮箱3312@163.com" _
    & vbCrLf _
    & vbCrLf & "2018年6月"
    Duration = Val(InputBox(prompt, "演讲倒计时管理器", "30"))

    '将演讲时间单位转换为秒
    If Duration <= 0 Then
        Exit Sub
        'Duration = 45 * 60
    ElseIf Duration > 300 Then
        Duration = 300 * 60
    Else
        Duration = Duration * 60
    End If

     '在母板上添加一个文本框，用以显示时间；该文本在结束放映时被删除。
    Dim txtShowTime As Shape
    Set txtShowTime = ActivePresentation.SlideMaster.Shapes.AddTextbox(msoTextOrientationHorizontal, ActivePresentation.SlideMaster.Width - 100, 5, 110, 40)
    '设置该文本框的Name属性
    txtShowTime.Name = "Timer"
    '设置该文本框的文本格式
    txtShowTime.TextFrame.TextRange.Text = "倒计时开始"
    With txtShowTime.TextFrame.TextRange.Font
        .Name = "New Time Roman"
        .Size = 20
        .Bold = msoTrue
        .Color.RGB = RGB(255, 50, 0)
    End With

    '创建定时器，触发时间为1秒，到时执行TimerProc过程
    TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
    If TimerID = 0 Then
        ActivePresentation.SlideMaster.Shapes("Timer").Delete
        MsgBox "由于系统原因，不能创建定时器！"
        Exit Sub
    End If

End Sub

Private Sub thisApp_SlideShowEnd(ByVal Pres As Presentation)
   If TimerID <> 0 Then
        '终止定时器
        TimerID = KillTimer(0, TimerID)
        '删除时间显示文本框
        ActivePresentation.SlideMaster.Shapes("Timer").Delete
   End If
End Sub



Public thisPPT As New CTimer
Public Duration As Long  '演讲时间

Sub Auto_Open()

    ' 启动PowerPoint时可以自动运行的宏
    Set thisPPT.thisApp = Application

End Sub
Sub Auto_Close()

    ' 关闭PowerPoint时可以自动运行的宏
    Set thisPPT.thisApp = Nothing

End Sub

'定时器到时的时候要执行的过程
Public Sub TimerProc()

    'DoEvents

    '剩余的秒数
    Duration = Duration - 1
    '将剩余的秒数转换为"时：分：秒"的格式
    '小时数
    h = Int(Duration / 3600)

    temp = Duration Mod 3600

    '分钟数
    m = Int(temp / 60)
    '秒数
    s = temp Mod 60

    '函数TimeSerial将小时数、分钟数、秒数合并成时间格式

    If TimeSerial(h, m, s) <= TimeSerial(0, 0, 0) Then
        '退出放映
        ActivePresentation.SlideShowWindow.View.Exit
    Else
        '在文本框中显示时间
        ActivePresentation.SlideMaster.Shapes("Timer").TextFrame.TextRange.Text = Format(TimeSerial(h, m, s), "演讲计时" & "hh:mm:ss")
    End If
End Sub

474489459

不是运行不畅，是跟本运行不了

474489459

出现红色的部分：
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private TimerID As Long

Public WithEvents thisApp As Application

Private Sub thisApp_SlideShowBegin(ByVal Wn As SlideShowWindow)

lipton

选定 Declare 按F1看看帮助,还有就是看看LONG类型的变体LongPtr

在Excel运行WINAPI 的例子：

1. Option Explicit
   
2. 
   
3. Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
   
4.                                                         ByVal nIDEvent As LongPtr, _
   
5.                                                         ByVal uElapse As LongPtr, _
   
6.                                                         ByVal lpTimerFunc As LongPtr) As Long
   
7. Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
   
8. 
   
9. 
   
10. Public lTimerID As Long
    
11. Private Const lDuration = 2000 '2秒
    
12. 
    
13. Public Sub endTimer()
    
14.     Dim rng As Range
    
15.    
    
16.     Set rng = Sheet1.Cells(1, 3)
    
17.     Do While Len(rng.Value) > 0
    
18.         Set rng = rng.Offset(1, 0)
    
19.     Loop
    
20.     rng.Value = "时间到!"
    
21.    
    
22.     KillTimer 0&, lTimerID
    
23. End Sub
    
24. 
    
25. Public Sub TimeStart()
    
26.     Dim rng As Range
    
27.    
    
28.     Set rng = Sheet1.Cells(1, 1)
    
29.     Do While Len(rng.Value) > 0
    
30.         Set rng = rng.Offset(1, 0)
    
31.     Loop
    
32.     rng.Value = "开始计时!"
    
33.    
    
34.     lTimerID = SetTimer(0&, 0&, lDuration, AddressOf endTimer)
    
35.    
    
36. End Sub

复制代码

474489459

lipton 发表于 2018-6-22 10:43
选定 Declare 按F1看看帮助,还有就是看看LONG类型的变体LongPtr

在Excel运行WINAPI 的例子：

还是不明白哦！

microyip

把这段

1. Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
2. Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

复制代码

换成

1. #If VBA7 And Win64 Then
   
2.     Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
3.     Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
   
4. #Else
   
5.     Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
6.     Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
   
7. #End If
   

复制代码

yylucke

microyip 发表于 2018-6-29 10:16
把这段

换成

学习了！
我前段时间遇见这样的问题，就直接放弃WinApi，懒得捣鼓。