如何使用进度条 onclick 事件答案

【问题标题】：How to use progress bar onclick event如何使用进度条 onclick 事件
【发布时间】：2016-04-21 18:37:08
【问题描述】：

您好，我正在尝试显示一个表单，显示在此 onclick 事件中执行的查询的进度：

Private Sub Command125_Click()

          '***************Statement Covers Period 104.03*****************
Dim countOfDays As Integer
Dim lngRed As Long

lngRed = RGB(255, 0, 0)

 countOfDays = DateDiff("d", Me.admit_date, Me.from_date)

 If countOfDays > 3 Then
    Me.from_date.ForeColor = lngRed
    Me.Label126.Visible = True
    'Select all lines on IS that contain a DOS 3 days prior
    'to the date of admission and enter reason code 104.03

    If FileExists("M:\A_Audit\Client_" & [Forms]![frmClients]![CLIENT_ID] & "\Client_" & [Forms]![frmClients]![CLIENT_ID] & ".xlsx") Then
        DoCmd.SetWarnings (False)
        DoCmd.OpenQuery ("qryErrorCode104-03")
        DoCmd.SetWarnings (True)

    Else
         MsgBox "Please upload Itemized Statement to identify more than 3 days" & _
    "discrepancy between statement from date and admission date."

    End If

End If

 '***************Diagnosis code incorrect for patients age 104.07*****************
Dim Count As Integer
DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qryErrorCode104-07 -1")
Count = DCount("*", "qryErrorCode104-07 -2")
If Count > 0 Then
Me.Label123.Visible = True
End If
DoCmd.DeleteObject acTable, "tmp10407"
DoCmd.SetWarnings (True)

  '***************Diagnosis code incorrect for patients sex 104.08*****************

DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qryErrorCode104-08 -1")
Count = DCount("*", "qryErrorCode104-08 -2")
If Count > 0 Then
Me.Label124.Visible = True
End If
DoCmd.DeleteObject acTable, "tmp10408"
DoCmd.SetWarnings (True)

End Sub

我尝试使用 ActiveXControl Microsoft ProgressBar Control 6.0 版，但没有成功。当我单击按钮运行代码时，进度条不会移动。任何帮助将不胜感激。提前谢谢你。

【问题讨论】：

我在该片段中没有看到任何引用进度条的内容。
我以前从未使用过进度条，那么我将如何引用进度条以及在哪里
你可能想查看这个问题以获得有关进度条的帮助，这里有很多信息，或者查看 msdn，我在 google 上找到了一些与创建进度条相关的文章：@987654321 @

标签： ms-access vba

【解决方案1】：

我真的没有看到任何真正的方法来判断进度，除了为每个步骤定义四分之一。因此，如果您添加一个 Active x 进度条并且它被称为 ProgressBar1，那么您可以执行类似这样的操作来更新它

Private Sub Command125_Click()

Me.ProgressBar1.Value = 25 'we are at the first leg so set to 25
DoEvents
          '***************Statement Covers Period 104.03*****************
Dim countOfDays As Integer
Dim lngRed As Long

lngRed = RGB(255, 0, 0)

 countOfDays = DateDiff("d", Me.admit_date, Me.from_date)

 If countOfDays > 3 Then
    Me.from_date.ForeColor = lngRed
    Me.Label126.Visible = True
    'Select all lines on IS that contain a DOS 3 days prior
    'to the date of admission and enter reason code 104.03

    If FileExists("M:\A_Audit\Client_" & [Forms]![frmClients]![CLIENT_ID] & "\Client_" & [Forms]![frmClients]![CLIENT_ID] & ".xlsx") Then
        DoCmd.SetWarnings (False)
        DoCmd.OpenQuery ("qryErrorCode104-03")
        DoCmd.SetWarnings (True)

    Else
         MsgBox "Please upload Itemized Statement to identify more than 3 days" & _
    "discrepancy between statement from date and admission date."

    End If

End If
Me.ProgressBar1.Value = 50 'we are at the second leg so set to 50
DoEvents
 '***************Diagnosis code incorrect for patients age 104.07*****************
Dim Count As Integer
DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qryErrorCode104-07 -1")
Count = DCount("*", "qryErrorCode104-07 -2")
If Count > 0 Then
Me.Label123.Visible = True
End If
DoCmd.DeleteObject acTable, "tmp10407"
DoCmd.SetWarnings (True)

Me.ProgressBar1.Value = 75 'we are at the 3rd leg so set to 75
DoEvents
  '***************Diagnosis code incorrect for patients sex 104.08*****************

DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qryErrorCode104-08 -1")
Count = DCount("*", "qryErrorCode104-08 -2")
If Count > 0 Then
Me.Label124.Visible = True
End If
DoCmd.DeleteObject acTable, "tmp10408"
DoCmd.SetWarnings (True)
Me.ProgressBar1.Value = 100 'We are done so set to 100

End Sub

【讨论】：