• 时间:
  • 分类:

Hi，大家好！

前言

很多 Access 系统都有一个很常见的问题：明明只是“保存成功”“导入完成”“校验失败”这种一眼就能看懂的信息，却偏偏要弹一个必须手动点“确定”的 MsgBox。

偶尔弹一次没什么，但如果是录单、审核、批量导入、定时处理这类高频场景，用户一天可能要点几十次，甚至上百次。提示是给到了，操作节奏也被打断了。

这类场景真正需要的，不是更响亮的提醒，而是不打断流程的反馈。

在 Web 应用里，这个问题通常会用 Toast 通知解决。操作完成后，右上角弹出一个小卡片，带颜色、图标和倒计时，几秒后自动消失。用户知道系统已经处理完了，但不需要停下来专门点一次确认。

回到 Access，其实也完全可以做出类似体验。相比常见的几种反馈方式，这种方案更适合业务系统：

方式主要问题
MsgBox模态弹窗，必须点击才能关闭，严重打断连续操作
状态栏文字提示太弱，用户很容易忽略
手工设计提示窗体每个项目都要单独做一套，难以复用

本文介绍一个纯 VBA 的 Toast 通知方案，目标不是“把 Access 做得像 Web 一样炫”，而是解决一个很具体的体验问题：让系统反馈更轻、更快、更顺手。

它可以做到：

  • 右上角弹出非模态通知卡片
  • 支持成功、信息、警告、错误四种类型
  • 底部带进度条倒计时，到时自动关闭
  • 鼠标悬停时暂停倒计时，避免用户还没看完就消失
  • 业务代码里一行即可调用

先看调用方式：

' 保存成功
ShowNotify "操作成功", "数据已保存到数据库。", ntSuccess

' 普通提示
ShowNotify "提示", "您有新消息。", ntInfo

' 警告提示
ShowNotify "注意", "有 3 条记录需要审核。", ntWarning, 10000

' 错误提示
ShowNotify "错误", "连接数据库失败！", ntError

如果你正在做的是录入、审核、导入导出、后台处理这类场景，这种提示方式通常会比 MsgBox 更合适。

一、技术原理分析

这个 Toast 通知的实现涉及几个关键技术点：

技术点方案说明
窗体生成CreateForm + CreateControl纯代码创建，无需手动设计
无边框弹窗BorderStyle = 0 + PopUp = True脱离 Access 主窗口，像独立卡片
屏幕定位Win32 API MoveWindow精确定位到屏幕右上角
倒计时Form_Timer 事件250 ms 间隔刷新进度条和秒数
悬停暂停Detail_MouseMove鼠标移入暂停，点击恢复
参数传递OpenArgs通过管道符分隔字符串传入类型、标题、消息、延时
代码注入VBComponents.CodeModule把事件代码写入窗体模块

颜色处理：Access 的 BGR 格式

Access 内部存储颜色使用 BGR 格式，而不是 Web 常用的 RGB。RGB() 函数返回的 Long 值实际上是 BGR 排列：

RGB(220, 53, 69) = 69 * 65536 + 53 * 256 + 220 = 4535772

在代码中直接使用 Long 常量，避免每次调用 RGB() 函数：

Private Const CLR_SUCCESS_BG As Long = 3394611   ' RGB(51,178,51) 绿
Private Const CLR_INFO_BG    As Long = 15060736  ' RGB(0,120,230) 蓝
Private Const CLR_WARNING_BG As Long = 1090815   ' RGB(255,165,16) 橙
Private Const CLR_ERROR_BG   As Long = 4535772   ' RGB(220,53,69) 红

屏幕定位：缇和像素的换算

Access 控件坐标使用缇（Twips）作为单位，而 Win32 API 使用像素。两者之间的换算关系是：

$$1 \text{ 英寸} = 1440 \text{ 缇} = \text{DPI} \text{ 像素}$$

所以换算公式为：

像素 = 缇 * DPI / 1440

代码中通过 GetDeviceCaps 获取当前屏幕 DPI，再做动态换算，确保在不同分辨率和缩放比例下都能正确定位。

二、实现步骤

第一步：创建通知窗体

执行后会自动创建一个名为 frmNotification 的窗体，包含以下控件：

控件名类型作用
lblIconBandLabel左侧颜色条，标识通知类型
lblIconLabelUnicode 图标（✔ ℹ ⚠ ✖）
lblTitleLabel通知标题
lblMessageLabel通知内容
btnCloseCommandButton手动关闭按钮
lblCountdownLabel剩余秒数显示
lblProgressBgLabel进度条背景（灰色）
lblProgressBarLabel进度条前景（随类型变色）
boxBorderRectangle外边框

这个窗体只需要创建一次。后续只要调用 ShowNotify 即可。

第二步：在业务代码里调用通知

窗体创建一次之后，后续在任意需要反馈的地方，一行代码即可弹出通知：

' 操作成功（绿色，默认 5 秒关闭）
ShowNotify "操作成功", "数据已保存到数据库。", ntSuccess

' 信息提示（蓝色）
ShowNotify "提示", "您有新消息。", ntInfo

' 警告（橙色，10 秒关闭）
ShowNotify "注意", "有 3 条记录需要审核。", ntWarning, 10000

' 错误（红色）
ShowNotify "错误", "连接数据库失败！", ntError

函数签名如下：

Public Sub ShowNotify(strTitle As String, _
                      strMsg As String, _
                      Optional nType As NotifyType = ntInfo, _
                      Optional lDelayMs As Long = 5000)
参数说明
strTitle通知标题
strMsg通知内容
nType通知类型：ntSuccess、ntInfo、ntWarning、ntError
lDelayMs自动关闭延迟，单位毫秒，默认 5000（5 秒）

三、完整源码

以下是完整代码，可直接复制使用：

Option Compare Database
Option Explicit

' === API: 移动窗体到屏幕右上角 ===
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If

Private Const SM_CXSCREEN As Long = 0
Private Const LOGPIXELSX As Long = 88

' === 颜色常量(BGR) ===
Private Const CLR_SUCCESS_BG As Long = 3394611
Private Const CLR_INFO_BG    As Long = 15060736
Private Const CLR_WARNING_BG As Long = 1090815
Private Const CLR_ERROR_BG   As Long = 4535772  ' RGB(220,53,69) 红

' === 状态变量 ===
Private m_DelayMs As Long
Private m_Elapsed As Long
Private m_Paused As Boolean
Private m_FullWidth As Long

' === 窗体加载 ===
Private Sub Form_Load()
    Dim parts() As String
    If Len(Nz(Me.OpenArgs, "")) = 0 Then
        DoCmd.Close acForm, Me.Name
        Exit Sub
    End If
    parts = Split(Me.OpenArgs, "|")
    If UBound(parts) < 3 Then Exit Sub

    Dim nType As Long
    nType = CLng(parts(0))
    Me.lblTitle.Caption = parts(1)
    Me.lblMessage.Caption = parts(2)
    m_DelayMs = CLng(parts(3))
    m_Elapsed = 0
    m_Paused = False
    m_FullWidth = Me.lblProgressBar.Width

    ' 根据类型设置颜色和图标
    Dim clr As Long
    Dim ico As String
    Select Case nType
        Case 0: clr = CLR_SUCCESS_BG: ico = ChrW(&H2714)
        Case 1: clr = CLR_INFO_BG:    ico = ChrW(&H2139)
        Case 2: clr = CLR_WARNING_BG: ico = ChrW(&H26A0)
        Case 3: clr = CLR_ERROR_BG:   ico = ChrW(&H2716)
        Case Else: clr = CLR_INFO_BG: ico = ChrW(&H2139)
    End Select

    Me.lblIconBand.BackColor = clr
    Me.lblProgressBar.BackColor = clr
    Me.lblIcon.Caption = ico

    ' 更新倒计时文本
    Me.lblCountdown.Caption = CStr(m_DelayMs \ 1000) & "s"

    ' 定位到屏幕右上角
    Call PositionTopRight

    ' 启动定时器(250ms 间隔)
    Me.TimerInterval = 250
End Sub

' === 定时器: 倒计时+进度条 ===
Private Sub Form_Timer()
    If m_Paused Then Exit Sub

    m_Elapsed = m_Elapsed + CLng(Me.TimerInterval)

    ' 更新进度条宽度(从满到空)
    Dim pct As Double
    pct = 1# - (CDbl(m_Elapsed) / CDbl(m_DelayMs))
    If pct < 0 Then pct = 0
    Me.lblProgressBar.Width = CLng(m_FullWidth * pct)

    ' 更新倒计时文字
    Dim remain As Long
    remain = (m_DelayMs - m_Elapsed) \ 1000
    If remain < 0 Then remain = 0
    Me.lblCountdown.Caption = CStr(remain) & "s"

    ' 时间到则关闭
    If m_Elapsed >= m_DelayMs Then
        Me.TimerInterval = 0
        DoCmd.Close acForm, Me.Name
    End If
End Sub

' === 鼠标悬停暂停 ===
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_Paused = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 鼠标离开(移到窗体外,触发Form级事件时恢复计时)
End Sub

' === 关闭按钮 ===
Private Sub btnClose_Click()
    Me.TimerInterval = 0
    DoCmd.Close acForm, Me.Name
End Sub

' === 点击通知任意位置恢复倒计时(取消暂停) ===
Private Sub Detail_Click()
    m_Paused = False
End Sub

' === 定位到屏幕右上角 ===
Private Sub PositionTopRight()
    Dim screenW As Long
    screenW = GetSystemMetrics(SM_CXSCREEN)

    ' 获取 DPI 换算(缇→像素)
    Dim hDC As LongPtr
    hDC = GetDC(0)
    Dim dpi As Long
    dpi = GetDeviceCaps(hDC, LOGPIXELSX)
    ReleaseDC 0, hDC

    ' 窗体尺寸(缇→像素): 1英寸=1440缇=dpi像素
    Dim wPx As Long, hPx As Long
    wPx = CLng(Me.Width * dpi / 1440)
    hPx = CLng(Me.Section(acDetail).Height * dpi / 1440) + 40

    ' 右上角,留 20px 边距
    Dim posX As Long, posY As Long
    posX = screenW - wPx - 20
    posY = 20

    MoveWindow Me.hwnd, posX, posY, wPx, hPx, 1
End Sub

四、运行效果与使用价值

调用 ShowNotify 后，屏幕右上角会弹出一个无边框的小卡片窗体。整体布局从左到右依次是：

  • 左侧色条：根据通知类型显示对应颜色，起到快速分类作用。
  • 图标区域：使用 Unicode 字符作为图标，避免额外图片资源依赖。
  • 文本区域：上方是标题，下方是消息正文。
  • 关闭按钮：右上角的 X 按钮，点击立即关闭。
  • 底部进度条：从满宽开始逐步缩短，直到归零后自动关闭。

    四种通知类型的视觉效果如下：
类型色条和进度条颜色图标典型场景
ntSuccess绿色✔保存成功、导入完成
ntInfo蓝色ℹ新消息提醒、状态变更
ntWarning橙色⚠数据需要审核、即将过期
ntError红色✖连接失败、校验不通过

从业务使用角度看，这种提示方式有 3 个直接好处：

  1. 用户不用被 MsgBox 反复打断，连续录入和审核更顺畅。
  2. 提示信息足够醒目，但不会遮挡主界面和当前操作。
  3. 通知样式可以标准化复用，不需要每个项目都重做一遍。

交互方面，鼠标移入通知卡片时，倒计时会自动暂停，防止用户还没看完就消失。点击卡片任意位置后，倒计时恢复。整个窗体是非模态的，不会阻塞用户继续操作主窗体。

五、注意点

  1. Access 颜色使用 BGR 格式。如果从 Web 上复制十六进制颜色值（如 #DC3545），需要手动翻转字节顺序为 &H4535DC，或者直接使用 RGB(220, 53, 69) 来得到正确的 Long 值。
  2. Win32 API 需要兼容 32/64 位。使用 #If VBA7 Then 条件编译，64 位环境下使用 PtrSafe 关键字和 LongPtr 类型。
  3. OpenArgs 传参使用管道符分隔。调用方通过 Type|Title|Message|Delay 格式传入参数，窗体 Form_Load 中用 Split 解析。如果标题或消息文本本身包含 | 字符，会导致解析错位，使用时需注意避免。
  4. TimerInterval 精度有限。Access 的 Form_Timer 最小间隔约 250 ms，进度条动画不会像 Web 端那样丝滑，但作为通知反馈已经足够。

六、总结

这套方案的重点，不是单纯把 Access 做成 Web 风格，而是把最常见的用户反馈做得更符合真实业务场景。核心价值有 4 点：

  1. 用非模态通知替代频繁弹出的 MsgBox，减少对用户操作节奏的打断。
  2. 通过 BorderStyle = 0、PopUp = True、Modal = False 做出轻量的卡片式提示效果。
  3. 利用 Win32 API 精确定位窗体，并通过 Form_Timer 驱动倒计时和进度条动画。
  4. 通过统一的 ShowNotify 接口，把成功、提示、警告、错误四类反馈标准化。

如果你的 Access 系统里经常出现“保存成功”“导入完成”“校验失败”这类提示，这种 Toast 方案通常会比传统 MsgBox 更顺手，也更适合持续复用。

测试环境：Access 2010 及以上版本，Windows 7/10/11。

标签: none

添加新评论