没有循环的进度条答案

【问题标题】：progressbar without loop没有循环的进度条
【发布时间】：2013-03-15 13:59:27
【问题描述】：

我想我已经在整个互联网上搜索了一个简单的进度条，但我找不到在功能/子完成后取得进展的进度条。

我将在下面的代码中演示我想要的。我在 VBA 方面的知识是基本的也可以制作这样的东西。

我有一个带有按钮的表单，当我单击该按钮时，他应该执行以下操作：

Sub program()

progressbarform.show

Call function1
"set progressbar to 20%"

Call funcion2
"set progressbar to 40%"

Call function3
"set progressbar to 100%"

"Unload progressbar form"

End Sub

【问题讨论】：

看看您是否可以调整现有代码解决方案之一以满足您的需求 -- Pop up the Excel Statusbar?
调用函数1：ProgressBar1.Value = 25 调用函数2：ProgressBar1.Value = 40 等
我已经试过了，但是不行，可能是我做错了
你在打开关注焦点的表单后调用你的函数，看看我的回答，让我知道你的想法:)
查看Progress Meters 了解如何在工作表上使用的示例。

标签： excel vba

【解决方案1】：

您可以使用委托来完成这项工作。您的进度条与您执行功能 1、2 和 3 的形式不同，因此您应该尝试在进度条形式中执行。调用 form.Show 后，表单有焦点，函数 1,2 和 3 在表单关闭之前不会运行。

在您的进度条表单中（假设它有一个标签和一个进度条控件）放置一个将更新您的进度条的函数：

Public Sub UpdateProgress(intProgress As Integer, Optional strMessage As String)

    If Not IsMissing(strMessage) Then
        lbl_Progress.Caption = strMessage
    End If
    pb_Progress.Value = intProgress
    Call Me.Repaint

End Sub

然后您可以在进度条表单中执行您的功能。您可以通过将调用它的表单设置为对象来公开您的函数或仅将函数 1,2 和 3 存储在进度条表单中来做到这一点。

Sub RunFunctions()

    UpdateProgress 0, "Starting functions"    

    UpdateProgress 10, "Begin function1"    
    Call function1
    UpdateProgress 30, "Finished function1"  

    UpdateProgress 50, "Begin function2"    
    Call function2
    UpdateProgress 70, "Finished function2"  

    UpdateProgress 90, "Begin function3"    
    Call function3
    UpdateProgress 100, "Finished function3"

    UpdateProgress 100, "Finished All Functions"

End Sub

如果您需要有关设置的帮助，请向我提问。

【讨论】：

嘿，谢谢你的回答，我马上去试试。当我需要帮助时会发表评论
我在 UpdateProgress0 上收到错误，未定义子或功能，但我将功能代码粘贴到同一个用户表单中
是我的代码粘贴不好，UpdateProgress和整数之间没有空格，现在试试吧。
还有一个问题.. 如果我想在另一个模块的函数中更新进度，该怎么做？
nvm 我找到了。只需添加“userFrom1.Update...”

【解决方案2】：

Sub program()

UserForm1.ProgressBar1.Min = 0
UserForm1.ProgressBar1.Max = 100
UserForm1.ProgressBar1.Value = 0

UserForm1.Show vbModeless

Call function1
UserForm1.ProgressBar1.Value = 20

Call funcion2
UserForm1.ProgressBar1.Value = 40

Call function3
UserForm1.ProgressBar1.Value = 100

End Sub

【讨论】：

在同一个函数中调用 UserForm1.Show 然后调用 function1,2,3 和重绘将不起作用，因为 UserForm1.Show 占据了执行的焦点，而随后的 Call function1 则不会执行直到你关闭或隐藏UserForm1。
@Blue：是的，你是对的，所以我编辑了答案并将 vbModeless 参数添加到 Show :-)。
现在最好将它设置为无模式。在 Excel VBA 中，这只是 UserForm1.Show False 。 +1 :)
@Blue：是的，它也适用于“False”，但使用常量更准确，代码更明显。 Show 方法有一个可选参数“modal”，它可以是 vbModal 或 vbModeless（VBA.FormShowConstants 枚举）。如果我们使用“False”，那么隐式转换会将“False”转换为“0”，这相当于 vbModeless。但是 UserForm1.Show True 不起作用，因为 'True' 被转换为 '-1' 而这不等于 vbModal。但是 modal 是默认的，所以 Show 不需要用 'True' 调用......这将失败。所以我认为使用由 constantnt 命名的值会更好。
@Blue：我不知道在 Excel 2010 中存在这样的问题。感谢您的信息！

【解决方案3】：

您的示例代码可以工作。

当您执行您的子程序时，代码会按顺序运行。因此，当function1 被调用时，在function1 完成之前，下面的代码将不会执行，所有其他函数也是如此。

最大的问题可能是在表单上添加进度条控件。我试过了（很快），但由于图书馆没有注册，它不会让我添加一个。

您可以使用标准控件创建一个虚假的进度条。

【讨论】：

【解决方案4】：

我不知道我的回答是否有帮助，但我在没有任何循环的主 vba 中制作了进度条。希望这能有所帮助。

我认为为了使用用户表单，你必须先在这里放一些东西来激活用户表单，所以 probar-----（第二个子的名称）在这里激活这个用户表单。代码如下：

Private Sub UserForm_Activate()

progbar

End Sub

第二个 sub 完全是空的，只有 sub 和 end sub，我把它放在 Module 1 中，它是空白模块。

Sub probar()
' leave this macro blank.

End Sub

最后，在您的主 vba 中，您可以选择百分比是多少以及要显示条形的时间，而不是循环，您只需自己更改百分比和条形长度，将您的代码放在这些百分比和这就是我让它工作的方式。

Public Sub Mainprogram()

'your code Part 1 blah blah blah

UserForm1.Text.Caption = "10% Completed"
UserForm1.bar.Width = 20
UserForm1.Show vbModeless
DoEvents

'your code Part 2 blah blah blah

UserForm1.Text.Caption = "50 % Completed"
UserForm1.bar.Width = 100
Application.Wait (Now + TimeValue("0:00:01"))
DoEvents

'your code Part 3 blah blah blah

UserForm1.Text.Caption = "100 % Completed"
UserForm1.bar.Width = 200
Application.Wait (Now + TimeValue("0:00:01"))
DoEvents

End Sub

【讨论】：

【解决方案5】：

用 2 Labels 制作一个表格，第一个用你的进度颜色，另一个用 xx%

现在，在您的脚本执行的每一步中，都会更改两个 Labels 的宽度，因此左侧 Label 变得更宽，右侧 Labels 左侧位置以相同数量的像素移动，并更新第二个的标题标签。左边达到100%的时候右边留足够的空间Label

【讨论】：

好主意，我明白，但我不确定我能不能编程
你能具体说说你卡在哪里了吗？
当您有可用的进度条控件时，我会尽量避免使用标签。
蓝色，我在列表中没有那个控件，它是默认的吗？它叫什么？
您右键单击控件框或转到工具>附加控件。您可以在 Microsoft ProgressBar Control, version 6.0 下找到它。它使用 MsComCtl.ocx 作为参考，该参考适用于所有装有 Office 2000 及更高版本的 PC。