Excel VBA 定时循环提醒完整代码

本文于2023年7月8日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

☆本期内容概要☆

• VBA 定时提醒完整代码

定时循环提醒完整代码：

1、ThisWorkbook

Private Sub Workbook_Open()
    Dim mWidth As Integer
    Dim mHeight As Integer
    With ActiveWindow
        .WindowState = xlMaximized
        mWidth = .Width
        mHeight = .Height
    End With
    '居中窗口
    With ActiveWindow
        .WindowState = xlNormal
        .Top = (mHeight - .Height) / 2
        .Left = (mWidth - .Width) / 2
    End With
    Call 定时执行
End Sub

代码解释：

（1）调整窗口大小与位置（其实调不调无所谓，主要是为了方便我录屏）

（2）调用“定时执行”过程。

2、Sheet3 （重点跟进表）

Private Sub cmdStart_Click()
    If Switch = True Then Exit Sub
    Call 定时执行
End Sub
Private Sub cmdStop_Click()
    Call 停止执行
    Me.CmdStart.Caption = "启动"
End Sub

代码解析：

（1）点击“启动”，首先判断一下Switch变量是否为TRUE，如果为TRUE则退出过程。当自动提提醒功能在运行的时候，Switch为TRUE，避免多次执行“定时执行”过程，造成重复提醒。

（2）点击“停止”，调用“停止执行”过程，把CmdStart按钮的Caption改为“启动”。

3、模块1

（1）定义变量，声明API函数

Public Msg As String
Public Timeinterval
Public Switch As Boolean ' 标识是否继续执行定时器代码
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
    ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
    ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Public glngTimerID As LongPtr, gsngTimeX As Single

代码解析：

（A）通过声明 SetTimer 函数，我们可以在 VBA 代码中使用这个函数来创建一个定时器，以指定的时间间隔触发回调函数。

（B）通过声明 KillTimer 函数，我们可以在 VBA 代码中使用这个函数来停止一个已创建的定时器。

（2）Sub OnTimer

Public Sub OnTimer()
    gsngTimeX = gsngTimeX + 0.1
    If gsngTimeX > 100 Then
        gsngTimeX = gsngTimeX - 100
    End If
    Sheets("重点跟进").CmdStart.Caption = Format(gsngTimeX, "0.0")
End Sub

代码解析：

（A）gsngTimeX 变量递增 0.1，用于记录定时器的累计时间。

（B）如果gsngTimeX 大于 100，则减去 100，以保持在 0 到 100 的范围内，避免数字过大显示不正常。

（C）在命令按钮上显示gsngTimeX的时间值。

（D）如果上述时间在不断变化显示，说明自动提醒正在运行。

（3）定时执行()

Sub 定时执行()
    '第一次调度执行
    Timeinterval = Sheets("重点跟进").Range("K2")
    gsngTimeX = 0
    glngTimerID = SetTimer(0, 0, 100, AddressOf OnTimer)
    MsgBox "自动提醒已开启"
    Switch = True ' 设置为 True，以允许继续执行定时器代码
    Application.OnTime Now + Timeinterval / 86400, "循环执行"
End Sub

代码解析：

（A）将 gsngTimeX 变量重置为0，以重新开始计时。

（B）调用 Windows API 函数 SetTimer 来创建一个定时器，时间间隔为100毫秒，并将定时器的回调函数设置为 OnTimer 子过程。

（C）将 Switch 变量设置为 True，以允许继续执行定时器代码。

（D）调度执行 循环执行() 子过程，延迟Timeinterval秒后执行第一次循环执行。

（4）循环执行()

Sub 循环执行()
    Call Reminder
    If Switch = False Then Exit Sub
    Application.OnTime Now + Timeinterval / 86400, "循环执行"
End Sub

代码解析：

（A）调用 Reminder 子过程，执行提醒操作。

（B）如果Switch 变量为 False，则退出子过程，停止定时器的执行。

（C）调度执行下一次循环执行，延迟 Timeinterval 秒后执行。

（5）停止执行()

Sub 停止执行()
    Switch = False ' 设置为 False，以停止定时器代码的执行
    Call KillTimer(0, glngTimerID)
    MsgBox "自动提醒已停止"
End Sub

代码解析：

（A）将 Switch 变量设置为 False，以停止定时器代码的执行。

（B）调用 Windows API 函数 KillTimer 来停止定时器的执行。

（6）Reminder()，根据设定的条件，在工作表的特定范围内检查是否有需要提醒的项目，生成提醒消息并显示在消息框中。同时，根据条件设置行的字体颜色

Sub Reminder()
    Dim ws As Worksheet
    Dim lastRow As Integer
    If Switch = False Then Exit Sub
    Msg = ""
    Set ws = Sheets("重点跟进")
    ws.Activate
    With ws
        lastRow = .UsedRange.Rows.Count
        Timeinterval = .Range("K2")
        If Not IsNumeric(Timeinterval) Then
            MsgBox "请输入正确的时间间隔，单位为秒。"
            Switch = False
            Exit Sub
        End If
        If Timeinterval < 5 Then
            MsgBox "请输入大于等于5秒的数字。"
            Switch = False
            Exit Sub
        End If
        For i = 2 To lastRow
            If .Range("I" & i) = "" Then    '已处理列不为空，则不再提醒
                If .Range("h" & i) - Now <= 0 Then
                    Msg = Msg & .Range("b" & i) & .Range("d" & i) & "马上要跟进啦" & Chr(10) & Chr(10)
                    Rows(i).Font.ColorIndex = 3
                End If
            Else
            Rows(i).Font.Color = RGB(128, 128, 128)
            End If
        Next
    End With
     With ActiveWindow
        .WindowState = xlMaximized
        mWidth = .Width
        mHeight = .Height
    End With
    '居中窗口
    With ActiveWindow
        .WindowState = xlNormal
        .Top = (mHeight - .Height) / 2
        .Left = (mWidth - .Width) / 2
    End With
    If Msg <> "" Then
        MsgBox Msg
    Else
        MsgBox "暂无跟进项目"
    End If
End Sub

代码解析：

（A）如果Switch 变量为 False，则退出子过程，停止提醒操作。

（B）从工作表的单元格 K2 中获取时间间隔的值，赋给 Timeinterval 变量。如果Timeinterval不是数字，则弹出消息框并退出子过程。如果Timeinterval小于5则弹出消息框并退出子过程（避免过于频率地提示）。

（C）循环遍历第 2 行到最后一行。如果第 i 行的 I 列为空，且第 i 行的 H 列的时间小于等于当前时间），将提醒消息添加到 Msg 变量中，将第 i 行的字体颜色设置为红色。如果第 i 行的 I 列不为空，则将第 i 行的字体颜色设置为灰色。

（D）计算窗口的上边界和左边界，使窗口居中显示。

（E）如果 Msg 不为空，则显示 Msg 中存储的提醒消息。如果 Msg 为空，则显示消息框，提示"暂无跟进项目"。

☆猜你喜欢☆

☆我是安利达人☆

本文于2023年7月8日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！