Question

您好我正在尝试显示一个表单，显示在此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版，但没有运气。当我单击按钮运行代码时，进度条不会移动。任何帮助将不胜感激。提前谢谢。

Answer 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

如何使用进度条onclick事件

1 个答案: