PowerPoint VBA中的睡眠/等待计时器'；它不是CPU密集型的

我现在有一个PowerPoint演示文稿，它被用在计算机上作为某种信息亭或信息屏幕。 它从磁盘上的文本文件中读取文本。此文本文件中的文本显示在PowerPoint的文本框中，并且每5秒刷新一次。通过这种方式，我们可以编辑PowerPoint中的文本，而无需编辑PowerPoint演示文稿本身，因此它将继续运行。 到目前为止工作得很好，只有PowerPoint VBA不包含Application.Wait函数。请参见此处的完整子部分：

Sub Update_textBox_Inhoud()

Dim FileName As String
TextFileName = "C:\paht\to\textfile.txt"
If Dir$(FileName) <> "" Then

Application.Presentations(1).SlideShowSettings.Run
Application.WindowState = ppWindowMinimized


While True


    Dim strFilename As String: strFilename = TextFileName
    Dim strFileContent As String
    Dim iFile As Integer: iFile = FreeFile
    Open strFilename For Input As #iFile
    strFileContent = Input(LOF(iFile), iFile)
    Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
    Close #iFile


    waitTime = 5
    Start = Timer
    While Timer < Start + waitTime
        DoEvents
    Wend

Wend

Else

End If
End Sub

Sub-Update\u textBox\u Inhoud（）
将文件名设置为字符串
TextFileName=“C:\paht\to\textfile.txt”
如果Dir$（FileName）“，则
Application.Presentations（1）.SlideShowSettings.Run
Application.WindowState=ppWindowMinimized
虽然是真的
将strFilename设置为字符串：strFilename=TextFileName
将strFileContent设置为字符串
将iFile设置为整数：iFile=FreeFile
打开strFilename作为#i文件输入
strFileContent=输入（LOF（iFile），iFile）
应用程序.演示文稿（1）.幻灯片（1）.形状.范围（数组（“textBox\u Inhoud”））.TextFrame.TextRange=strFileContent
关闭#i文件
等待时间=5
开始=计时器
当定时器<开始+等待时间
多芬特
温德
温德
其他的
如果结束
端接头

正如您所见，我在一个循环中创建了一个5秒睡眠/等待函数，因为PowerPoint没有Application.wait函数

在运行这个宏时，我的第7代i5的CPU负载上升到36%。kiosk电脑的硬件稍差一些，因此CPU负载将相当高，而且这台电脑的风扇会发出很大的噪音

我认为sleep/wait函数并不是真正的“sleep”，它只是继续循环直到5秒过去

问题1：我的假设是该函数不是真的睡眠吗？

---

问题2：如果问题1的答案为真，是否有更好、CPU密集度更低的方法来创建睡眠功能？

睡眠不需要CPU周期。

#If VBA7 Then  
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems  
#Else  
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems  
#End If  
Sub SleepTest()  
MsgBox "Execution is started"  
Sleep 10000 'delay in milliseconds  
MsgBox "Execution Resumed"  
End Sub  

Sleep
是一个windows函数而不是VBA函数，但是您仍然可以通过调用windows
Sleep
API在VBA代码中使用此函数。实际上，
sleep
是Windows DLL文件中的一个函数。因此，在使用它们之前，您必须在模块中的代码上方声明API的名称

Sleep
语句的语法如下：

Sleep (delay)

示例：

#If VBA7 Then  
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems  
#Else  
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems  
#End If  
Sub SleepTest()  
MsgBox "Execution is started"  
Sleep 10000 'delay in milliseconds  
MsgBox "Execution Resumed"  
End Sub  

因此，基本上您的代码如下所示：

#If VBA7 Then

    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

#Else

    Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)

#End If

    Sub Update_textBox_Inhoud()

    Dim FileName As String
    TextFileName = "C:\paht\to\textfile.txt"
    If Dir$(FileName) <> "" Then
        Application.Presentations(1).SlideShowSettings.Run
        Application.WindowState = ppWindowMinimized

        While True
            Dim strFilename As String: strFilename = TextFileName
            Dim strFileContent As String
            Dim iFile As Integer: iFile = FreeFile
            Open strFilename For Input As #iFile
            strFileContent = Input(LOF(iFile), iFile)
            Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
            Close #iFile

           Sleep 5000
        Wend
    Else

    End If
    End Sub

#如果是VBA7，则
公共声明PtrSafe子睡眠库“kernel32”（ByVal毫秒为LongPtr）
#否则
公共声明子睡眠库“kernel32”（字节毫秒长）
#如果结束
子更新\u文本框\u Inhoud（）
将文件名设置为字符串
TextFileName=“C:\paht\to\textfile.txt”
如果Dir$（FileName）“，则
Application.Presentations（1）.SlideShowSettings.Run
Application.WindowState=ppWindowMinimized
虽然是真的
将strFilename设置为字符串：strFilename=TextFileName
将strFileContent设置为字符串
将iFile设置为整数：iFile=FreeFile
打开strFilename作为#i文件输入
strFileContent=输入（LOF（iFile），iFile）
应用程序.演示文稿（1）.幻灯片（1）.形状.范围（数组（“textBox\u Inhoud”））.TextFrame.TextRange=strFileContent
关闭#i文件
睡5000
温德
其他的
如果结束
端接头

结论：您没有使用真正的
睡眠功能。您所做的是使用CPU循环

请注意，在该网站上找到了此答案中的若干信息：：-->
请尝试以下方法

#If VBA7 Then

    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

#Else

    Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)

#End If

Sub Update_textBox_Inhoud()

Dim FileName As String
TextFileName = "C:\paht\to\textfile.txt"
If Dir$(FileName) <> "" Then
    Application.Presentations(1).SlideShowSettings.Run
    Application.WindowState = ppWindowMinimized

    While True
        Dim strFilename As String: strFilename = TextFileName
        Dim strFileContent As String
        Dim iFile As Integer: iFile = FreeFile
        Open strFilename For Input As #iFile
        strFileContent = Input(LOF(iFile), iFile)
        Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
        Close #iFile

       Sleep 5000
    Wend
Else
    'Is there no code here?
End If
End Sub

按照
等待特定的时间量，在循环中依次调用。它不是CPU密集型的，UI将保持响应：

Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long


Public Sub Wait(Seconds As Double)
    Dim endtime As Double
    endtime = DateTime.Timer + Seconds
    Do
        WaitMessage
        DoEvents
    Loop While DateTime.Timer < endtime
End Sub

Private声明PtrSafe函数WaitMessage Lib“user32”（长度为
公共子等待（秒为双精度）
时间是双倍的
endtime=DateTime.Timer+Seconds
做
等待消息
多芬特
在DateTime.Timer
谢谢您的建议。我在别处也发现了这个睡眠函数，但当我在代码中添加并运行它时，PowerPoint会变得没有响应。好像它没有执行睡眠，只是变成了一个无限循环。你的系统是什么@Roy 32位还是64位？@Roy也许您可以尝试使用
Wait
函数，但它将使用CPU。。要我编辑吗？
dwms
总是
一样长
，而不是
LongPtr
。然后停止使用这些源，改用文档。说应该使用
LongPtr
，因为它是一个Windows API是没有意义的
LongPtr
应用于指针大小的值<代码>睡眠
。无论操作系统位是多少，DWORD都是一个
。指针大小值的一个示例是
HWND
，它是
HANDLE
，它是
PVOID
，它是指向
void
的指针。这将使PowerPoint变得无响应是的，但我假设这不是问题，因为
Sleep
函数在演示文稿更新后发生，而且，由于演示文稿通常以静态图像为特征。
dw毫秒
总是
长
，而不是
LongPtr
。除此之外，它是
SetTimer Lib“user32”（ByVal hwnd为LongPtr，ByVal nIDEvent为LongPtr，ByVal uelaver为LongPtr，ByVal lpTimerFunc为LongPtr）和LongPtr
和
KillTimer Lib“user32”（ByVal hwnd作为LongPtr，ByVal nIDEvent作为LongPtr）只要
。这确实为我解决了问题。CPU在0%和1%之间运行，PowerPoint没有无响应。谢谢！