VBA调用UserForm进度条无法实时更新仅关闭后才刷新问题求助

• VBA中UserForm.Show默认是模态显示（vbModal），弹出后会阻塞后续业务代码执行，必须手动关闭窗口才会继续运行，因此每次调用Show都要先关闭旧窗口才会执行下一步代码，弹出更新了进度的新窗口。
• 进度更新逻辑写在UserForm_Activate事件中，仅窗口首次激活时会触发，后续进度值变动不会自动刷新界面。

修改UserForm配置与代码 #

首先在UserForm的属性面板将ShowModal属性设置为False，或调用Show时指定无模式参数。然后替换原有UserForm代码：

Private Sub UserForm_Activate()
    UserForm1.Height = 121.5
    ' 初始化进度
    Call UpdateProgress(0)
    UserForm1.Height = 136.5
End Sub

' 新增公共更新方法，外部可直接调用刷新进度
Public Sub UpdateProgress(progression As Integer)
    Image_barre.Width = progression * 1.5
    Label_barre.Caption = progression & "%"
    DoEvents ' 交出控制权刷新界面
End Sub

修改业务调用代码 #

仅需首次调用一次无模式显示，后续进度变动直接调用公共更新方法即可，无需重复调用Show：

Dim taille_progressbar As Integer
taille_progressbar = 0
' 仅调用一次无模式显示，不会阻塞后续代码执行
UserForm1.Show vbModeless

cn.Open (ConnectionString)
rs.Open "TRUNCATE Direction_Prix_proxi.prix_crf;", cn
rs.Open "TRUNCATE Direction_Prix_proxi.prix_crf_exp;", cn
rs.Open "TRUNCATE Direction_Prix_proxi.prix_int_exp;", cn
rs.Open "TRUNCATE Direction_Prix_proxi.prix_int_cnt;", cn
rs.Open "TRUNCATE Direction_Prix_proxi.prix_u;", cn

rs.Open "LOAD DATA LOCAL INFILE '\tomatisation\\prix_concurrents.csv" & _
        "' INTO TABLE direction_prix_proxi.prix_crf FIELDS TERMINATED BY ';' LINES TERMINATED BY '\n' IGNORE 2 LINES" & _
        " (SIGMA, @PRIX) set PRIX= replace(@PRIX, ',','.');", cn

rs.Open "Delete FROM direction_prix_proxi.prix_crf WHERE (SIGMA = 0);", cn

rs.Open "UPDATE direction_prix_proxi.matrice_sigma sgm INNER JOIN direction_prix_proxi.prix_crf ref on sgm.SIGMA = ref.SIGMA SET sgm.prix_crf_cty = ref.PRIX;", cn

' 直接调用更新方法刷新进度，无需重复调用Show
taille_progressbar = taille_progressbar + 20
Call UserForm1.UpdateProgress(taille_progressbar)

rs.Open "LOAD DATA LOCAL INFILE '\\ytkytkykty\tkkktyytk\16.Proxi\Fichiers_automatisation\\prix_concurrents.csv" & _
        "' INTO jrtjtrjtrjtrjtrjFIELDS TERMINATED BY ';' LINES TERMINATED BY '\n' IGNORE 2 LINES" & _
        " (@dummy, @dummy, @dummy, @dummy, @dummy, @dummy, @dummy, @dummy, SIGMA, @PRIX) set PRIX= replace(@PRIX, ',','.');", cn

rs.Open "Delete FROM jrtrjtrjf_exp WHERE (SIGMA = 0);", cn

rs.Open "UPDATE rtjtrjtrjtj sgm INNER JOIN direction_prix_proxi.prix_crf_exp ref on sgm.SIGMA = ref.SIGMA SET sgm.prix_crf_exp = ref.PRIX;", cn

taille_progressbar = taille_progressbar + 20
Call UserForm1.UpdateProgress(taille_progressbar)

' 所有业务执行完成后可主动关闭进度条
' Unload UserForm1

• DoEvents必须保留，作用是暂时将CPU控制权交还给界面线程，确保进度条界面实时刷新。
• 所有业务代码执行完成后，可主动调用Unload UserForm1关闭进度条窗口，无需用户手动关闭。
• 若需禁止用户在进度执行过程中操作Excel主界面，可在调用Show前添加Application.Interactive = False，执行完成后再改回True即可。

内容的提问来源于stack exchange，提问作者François Maurice