CAD VBA（6.0）中进度条的实现方案（试行版）（7.0版本方案另有文章发布）

本文介绍了如何在VBA6.0中使用UserForm创建进度条，监控处理指定文件夹内DWG文件的进度。通过代码展示了文件计数、逐个打开和关闭文件的操作，以及效果展示与优化建议。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

在vba（6.0）处理数据过程中，进度条可以帮助我们实时了解程序运行的进程。本文以并逐个打开关闭指定文件夹内DWG文件为例，具体方案如下：

一、进度条及窗体的设置

如图所示：

（userform1的caption值改为"处理进度" ）

二、窗体模块代码部分

1.双击userform1窗体，进入代码界面后加入以下代码：

Private Sub UserForm_Activate()
Dim folderPath As String, filename As String
Dim path As String
Dim count_all As Integer, count_progress As Integer
folderPath = GetDirectory
Label1.Caption = "0%"
filename = Dir(folderPath & "\*.dwg") ''获取路径用于统计文件总数
Do While filename <> ""
    count_all = count_all + 1
    filename = Dir()
Loop
ProgressBar1.Min = 0
ProgressBar1.Max = count_all
filename = Dir(folderPath & "\*.dwg")  ''重新获取路径进行循环
Do While filename <> ""
    filefullName = folderPath & "\" & filename
    Documents.Open filefullName
    ThisDrawing.Close
    filename = Dir()
    count_progress = count_progress + 1
    ProgressBar1.Value = Str(count_progress)
    Label1.Caption = Round(count_progress / ProgressBar1.Max, 2) * 100 & "%"
    DoEvents
Loop
Unload UserForm1
MsgBox "已完成"
End Sub

2.插入模块，在通用界面输入以下代码：

Declare Function SHBrowseForFolder Lib "SHELL32.DLL" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public choice As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Function GetDirectory(Optional message) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0
bInfo.lpszTitle = "请选择需处理数据所在文件夹"
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(256)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
    pos = InStr(path, Chr(0))
    GetDirectory = Left(path, pos - 1)
Else
    GetDirectory = ""
End If
End Function