请求协助：用VBA创建进度条监控工作簿查询整体刷新进度

需求概述 #

当通过Excel数据选项卡的「全部刷新」按钮（对应Sample1的操作方式）刷新工作簿查询时，显示一个具备实时进度监控功能（对应Sample2的功能）、且使用自定义外观样式（对应Sample3的样式）的进度条。

实现步骤 #

1. 创建自定义进度条用户窗体 #

打开VBA编辑器（按Alt+F11），插入用户窗体并命名为frmProgressBar，添加以下控件并设置样式：

• 状态标签（lblStatus）：用于显示刷新状态文本，设置居中对齐，初始文本为「准备刷新...」
• 进度容器框架（fraBarContainer）：作为进度条的背景容器，设置背景色为浅灰色，取消边框
• 进度填充标签（lblProgressFill）：作为进度填充块，设置背景色为自定义高亮色（如深蓝色/橙色），初始宽度设为0
• 窗体本身：取消标题栏文字，设置单一线条边框，调整尺寸到合适大小（匹配Sample3的外观比例）

2. 进度条控制代码 #

在frmProgressBar的代码模块中添加以下代码，用于更新和重置进度：

' 更新进度条显示
Public Sub UpdateProgress(percentComplete As Double, statusText As String)
    Me.lblStatus.Caption = statusText
    Me.lblProgressFill.Width = Me.fraBarContainer.Width * percentComplete
    Me.Repaint ' 强制刷新界面
End Sub

' 重置进度条到初始状态
Public Sub ResetProgress()
    Me.lblProgressFill.Width = 0
    Me.lblStatus.Caption = "准备刷新..."
    Me.Repaint
End Sub

3. 绑定查询刷新事件 #

在ThisWorkbook代码模块中添加代码，捕获查询的刷新生命周期事件：

Private WithEvents qt As QueryTable

Private Sub Workbook_Open()
    ' 绑定第一个查询表（若有多个查询，需遍历绑定，见下文扩展方案）
    For Each qt In ThisWorkbook.Worksheets("目标工作表名称").QueryTables
        Set qt = qt
        Exit For
    Next qt
End Sub

' 刷新前显示进度条
Private Sub qt_BeforeRefresh(Cancel As Boolean)
    frmProgressBar.ResetProgress
    frmProgressBar.Show vbModeless ' 非模态显示，不阻塞刷新操作
End Sub

' 实时更新进度
Private Sub qt_ProgressUpdate(ByVal PercentComplete As Integer)
    frmProgressBar.UpdateProgress PercentComplete / 100, "已完成 " & PercentComplete & "%..."
End Sub

' 刷新完成后关闭进度条
Private Sub qt_AfterRefresh(ByVal Success As Boolean)
    Unload frmProgressBar
    If Success Then
        MsgBox "刷新完成！", vbInformation
    Else
        MsgBox "刷新失败，请检查查询连接！", vbCritical
    End If
End Sub

4. 多查询表适配扩展（可选） #

如果工作簿包含多个需要监控的查询表，使用类模块批量绑定事件：

1. 插入类模块，命名为clsQueryMonitor，添加代码：

Public WithEvents qt As QueryTable

Private Sub qt_BeforeRefresh(Cancel As Boolean)
    If Not frmProgressBar.Visible Then
        frmProgressBar.ResetProgress
        frmProgressBar.Show vbModeless
    End If
End Sub

Private Sub qt_ProgressUpdate(ByVal PercentComplete As Integer)
    frmProgressBar.UpdateProgress PercentComplete / 100, "正在刷新查询... 已完成 " & PercentComplete & "%..."
End Sub

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
    ' 检查是否还有查询在刷新
    Dim q As QueryTable
    Dim isRefreshing As Boolean
    isRefreshing = False
    
    For Each q In ThisWorkbook.Worksheets
        If q.Refreshing Then
            isRefreshing = True
            Exit For
        End If
    Next q
    
    If Not isRefreshing Then
        Unload frmProgressBar
        MsgBox IIf(Success, "所有查询刷新完成！", "部分查询刷新失败，请检查！"), IIf(Success, vbInformation, vbExclamation)
    End If
End Sub

2. 修改ThisWorkbook代码，批量绑定所有查询：

Private colQueryMonitors As Collection

Private Sub Workbook_Open()
    Set colQueryMonitors = New Collection
    Dim ws As Worksheet
    Dim qt As QueryTable
    Dim clsMonitor As clsQueryMonitor
    
    For Each ws In ThisWorkbook.Worksheets
        For Each qt In ws.QueryTables
            Set clsMonitor = New clsQueryMonitor
            Set clsMonitor.qt = qt
            colQueryMonitors.Add clsMonitor
        Next qt
    Next ws
End Sub

5. 样式自定义优化 #

如果需要实现Sample3的特殊样式（如圆角、渐变填充）：

• 圆角效果：可以通过API函数修改窗体和控件的圆角，或使用Shape控件替代标签作为进度条容器
• 渐变填充：使用Shape的填充属性设置渐变颜色，替换lblProgressFill标签

内容的提问来源于stack exchange，提问作者Jun Kelvin Kimayong