我想在表单中添加一个进度条,考虑到我正在运行多个查询,比如30个查询,并且我希望进度条随着查询的执行而增长。 这是我的代码:
Private Sub Command5_Click()
Dim X As Integer
X = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If X = vbOK Then
' If PASSWORD = "222222" Then
Dim intX, intY As Integer
DoCmd.SetWarnings False
Me.Refresh
' DoCmd.Close acForm, "enterpassword"
With CurrentDb
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
MsgBox (intX & " RECORDS WILL BE ADDED")
Call .QueryDefs("UPDATE_Jobsorder1_SERVER_WITH_Jobsorder").Execute
Call .QueryDefs("UPDATE_Jobsorder2_SERVER_WITH_Jobsorder").Execute
Call .QueryDefs("UPDATE_General1_SERVER_WITH_General").Execute
Call .QueryDefs("UPDATE_General2_SERVER_WITH_General").Execute
Call .QueryDefs("UPDATE_Hydrant1_SERVER_WITH_Hydrant").Execute
Call .QueryDefs("UPDATE_Hydrant2_SERVER_WITH_Hydrant").Execute
Call .QueryDefs("UPDATE_Inspect1_SERVER_WITH_Inspect").Execute
Call .QueryDefs("UPDATE_Inspect2_SERVER_WITH_Inspect").Execute
Call .QueryDefs("UPDATE_Mains1_SERVER_WITH_Mains").Execute
Call .QueryDefs("UPDATE_Mains2_SERVER_WITH_Mains").Execute
Call .QueryDefs("UPDATE_Services1_SERVER_WITH_Services").Execute
Call .QueryDefs("UPDATE_Services2_SERVER_WITH_Services").Execute
Call .QueryDefs("UPDATE_Valves1_SERVER_WITH_Valves").Execute
Call .QueryDefs("UPDATE_Valves2_SERVER_WITH_Valves").Execute
Call .QueryDefs("UPDATE_WortendykeJobs1_SERVER_WITH_WortendykeJobs").Execute
Call .QueryDefs("UPDATE_WortendykeJobs2_SERVER_WITH_WortendykeJobs").Execute
Call .QueryDefs("Append RECORDS IN General NOT IN General1 to General1").Execute
Call .QueryDefs("Append RECORDS IN General NOT IN General2 to General2").Execute
Call .QueryDefs("Append RECORDS IN Hydrant NOT IN Hydrant1 to Hydrant1").Execute
Call .QueryDefs("Append RECORDS IN Hydrant NOT IN Hydrant2 to Hydrant2").Execute
Call .QueryDefs("Append RECORDS IN Inspect NOT IN Inspect1 to Inspect1").Execute
Call .QueryDefs("Append RECORDS IN Inspect NOT IN Inspect2 to Inspect2").Execute
Call .QueryDefs("APPEND RECORDS IN jobsOrder NOT IN Jobsorder1 to JobsOrder1").Execute
Call .QueryDefs("APPEND RECORDS IN jobsOrder NOT IN Jobsorder2 to JobsOrder2").Execute
Call .QueryDefs("APPEND RECORDS IN Mains NOT IN Mains1 to Mains1").Execute
Call .QueryDefs("APPEND RECORDS IN Mains NOT IN Mains2 to Mains2").Execute
Call .QueryDefs("APPEND RECORDS IN Services NOT IN Services1 to Services1").Execute
Call .QueryDefs("APPEND RECORDS IN Services NOT IN Services2 to Services2").Execute
Call .QueryDefs("APPEND RECORDS IN Valves NOT IN Valves1 to Valves1").Execute
Call .QueryDefs("APPEND RECORDS IN Valves NOT IN Valves2 to Valves2").Execute
Call .QueryDefs("APPEND RECORDS IN Wort NOT IN WortendykeJobs1 to WortendykeJobs1").Execute
Call .QueryDefs("APPEND RECORDS IN Wort NOT IN WortendykeJobs2 to WortendykeJobs2").Execute
'Call .QueryDefs("DELETE_Records_JobsOrder").Execute
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
' Else
' MsgBox ("password Invalid!!!")
' End If
Exit Sub
ElseIf X = vbCancel Then
Exit Sub
End If
End Sub
答案 0 :(得分:1)
为了正确地执行此操作(即在执行QueryDef
之后不执行进度条指令),我们应该能够遍历所有查询。因此,最简单的方法是将所有SQL指令放在array
或collection
中,我选择了后者。
添加到您的表单1个矩形,它将成为您的进度条背景,为其指定背景颜色并将其命名为 ProgressBarA
复制/粘贴 ProgressBarA ,将此新矩形命名为 ProgressBarB ,并将其放在 ProgressBarA 上,然后再将其添加到背景颜色并制作它#39 ; s宽度稍短,所以你可以看到两个矩形,这更容易。这将是"填满"
的标准Private colSQL As Collection
Private Sub Define_SQL_Queries()
Set colSQL = New Collection
colSQL.Add "UPDATE_Jobsorder2_SERVER_WITH_Jobsorder"
colSQL.Add "UPDATE_General1_SERVER_WITH_General"
colSQL.Add "UPDATE_General2_SERVER_WITH_General"
colSQL.Add "UPDATE_Hydrant1_SERVER_WITH_Hydrant"
colSQL.Add "UPDATE_Hydrant2_SERVER_WITH_Hydrant"
colSQL.Add "UPDATE_Inspect1_SERVER_WITH_Inspect"
colSQL.Add "UPDATE_Inspect2_SERVER_WITH_Inspect"
colSQL.Add "UPDATE_Mains1_SERVER_WITH_Mains"
colSQL.Add "UPDATE_Mains2_SERVER_WITH_Mains"
colSQL.Add "UPDATE_Services1_SERVER_WITH_Services"
colSQL.Add "UPDATE_Services2_SERVER_WITH_Services"
colSQL.Add "UPDATE_Valves1_SERVER_WITH_Valves"
colSQL.Add "UPDATE_Valves2_SERVER_WITH_Valves"
colSQL.Add "UPDATE_WortendykeJobs1_SERVER_WITH_WortendykeJobs"
colSQL.Add "UPDATE_WortendykeJobs2_SERVER_WITH_WortendykeJobs"
colSQL.Add "Append RECORDS IN General NOT IN General1 to General1"
colSQL.Add "Append RECORDS IN General NOT IN General2 to General2"
colSQL.Add "Append RECORDS IN Hydrant NOT IN Hydrant1 to Hydrant1"
colSQL.Add "Append RECORDS IN Hydrant NOT IN Hydrant2 to Hydrant2"
colSQL.Add "Append RECORDS IN Inspect NOT IN Inspect1 to Inspect1"
colSQL.Add "Append RECORDS IN Inspect NOT IN Inspect2 to Inspect2"
colSQL.Add "APPEND RECORDS IN jobsOrder NOT IN Jobsorder1 to JobsOrder1"
colSQL.Add "APPEND RECORDS IN jobsOrder NOT IN Jobsorder2 to JobsOrder2"
colSQL.Add "APPEND RECORDS IN Mains NOT IN Mains1 to Mains1"
colSQL.Add "APPEND RECORDS IN Mains NOT IN Mains2 to Mains2"
colSQL.Add "APPEND RECORDS IN Services NOT IN Services1 to Services1"
colSQL.Add "APPEND RECORDS IN Services NOT IN Services2 to Services2"
colSQL.Add "APPEND RECORDS IN Valves NOT IN Valves1 to Valves1"
colSQL.Add "APPEND RECORDS IN Valves NOT IN Valves2 to Valves2"
colSQL.Add "APPEND RECORDS IN Wort NOT IN WortendykeJobs1 to WortendykeJobs1"
colSQL.Add "APPEND RECORDS IN Wort NOT IN WortendykeJobs2 to WortendykeJobs2"
End Sub
Private Sub Command5_Click()
Dim X As Integer
Dim i As Integer
Dim strSQL As String
X = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If X = vbOK Then
' If PASSWORD = "222222" Then
Dim intX, intY As Integer
' REINIT PROGRESS BAR
ProgressBarB.Width = 0
Me.Repaint
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries
DoCmd.SetWarnings False
Me.Refresh
' DoCmd.Close acForm, "enterpassword"
With CurrentDb
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
MsgBox (intX & " RECORDS WILL BE ADDED")
For i = 1 To colSQL.Count
strSQL = colSQL(i)
Debug.Print "Executing : " & strSQL
Call .QueryDefs(strSQL).Execute
ProgressBarB.Width = (ProgressBarA.Width / colSQL.Count) * i
Me.Repaint
Next i
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
' Else
' MsgBox ("password Invalid!!!")
' End If
Exit Sub
ElseIf X = vbCancel Then
Exit Sub
End If
End Sub
未经测试,但您有这个想法。如果它不能马上工作,它应该经过一些小的调整