2016-04-21 46 views
1

你好,我想显示一种形式,显示在此onclick事件进行查询的进度:如何使用进度条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微软进度控制试过,6.0版本没有运气。当我点击按钮来运行代码时,进度条不会移动。任何帮助将不胜感激。先谢谢你。

+2

我没有看到任何引用该snippit中的进度条的东西。 – Sorceri

+0

我以前从未使用过进度条,所以如何参考进度条以及在哪里 – SikRikDaRula

+1

您可能想要检查此问题以寻求进度条帮助,此处包含大量信息,或者查看msdn,我发现了一些有关在谷歌上创建进度条的文章:http://stackoverflow.com/questions/11956834/progress-bar-in-in-ms-access – MoondogsMaDawg

回答

0

我真的没有看到任何真正的方法来判断进度,而不是在每个步骤的宿舍中定义它。所以如果你添加一个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