本文于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 SubPrivate 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 StringPublic TimeintervalPublic 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 LongPtrPrivate Declare PtrSafe Function KillTimer Lib "user32" ( _    ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPublic 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 IfEnd 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 为空，则显示消息框，提示"暂无跟进项目"。

☆猜你喜欢☆

Excel VBA 电子发票管理助手

Excel VBA 收费管理系统

Excel VBA 中医诊所收费系统

Excel VBA 文件批量改名

Excel VBA 酷炫的日期控件

Excel VBA 动态添加控件

Excel VBA 最简单的收发存登记系统

Excel 固定资产折旧计提表

Excel VBA 输入逐步提示

Excel 公式函数/查找函数之LOOKUP

☆我是安利达人☆

我的小店

自用产品，强烈推荐！

白茶牙膏

洗洁精

洗衣液

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