Progress Bar
damorrison:
This examply brings in a recordset from Access and uses the
progressbar and a timer. You will need to change the path to
Nwind on your computer to test it, but as stated the trickey part
of a progressbar is to tie the bar to something meaninful, in this
example it is tied to the recordcount of the recourdset.
Put a cmd button, a progressBar and two labels on sheet1
'To use ADO objects in an application add a reference
'to the ADO component. From the VBA window select
'Tools/References< check the box
' "Microsoft ActiveX Data Objects 2.5 Library"
Post back if you have a problem it is kind of a fun example.
Private Sub CommandButton1_Click()
Dim lngStart As Double
Dim lngStop As Double
Dim lngTime As Double
lngStart = Timer
Dim db_Name As String
Dim DB_CONNECT_STRING As String
db_Name = ("C:\Program Files\Microsoft Visual Studio\VB98\NWIND.mdb")
DB_CONNECT_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & db_Name & ";" & ", , , adConnectAsync;"
'Create the connection
Dim cnn As New ADODB.Connection
Set cnn = New Connection
cnn.Open DB_CONNECT_STRING
'Create the recordset
Dim rs As ADODB.Recordset
Set rs = New Recordset
'Determines what records to show
Dim strSQL As String
'strSQL = "SELECT Orders.OrderID, Orders.ShipAddress FROM Orders;"
'Dim strSQL As String
strSQL = "SELECT Orders.OrderID, Orders.ShipAddress FROM Orders;"
'Retreive the records
rs.CursorLocation = adUseClient
rs.Open strSQL, cnn, adOpenStatic, adLockBatchOptimistic
Dim iRow As Integer
iRow = 3
Dim intCounter As Integer
Dim i As Integer
i = 0
ProgressBar1.Visible = True
ProgressBar1.Max = rs.RecordCount
Label1.Caption = "Total Items " & rs.RecordCount
Label1.BackColor = &HFFFF&
'ListBox1.Clear
With rs
.MoveFirst
Do Until .EOF
' ListBox1.AddItem rs("OrderID") & vbTab & rs("ShipAddress")
Worksheets("Sheet1").Range("A" & iRow) = rs("OrderID")
Worksheets("Sheet1").Range("C" & iRow) = rs("ShipAddress")
.MoveNext
iRow = iRow + 1
intCounter = intCounter + 1
ProgressBar1.Value = intCounter
Loop
End With
Worksheets("Sheet1").Range("A1") = "OrderID"
Worksheets("Sheet1").Range("C1") = "Shiping Address"
Worksheets("Sheet1").Range("A1:C1").Font.ColorInde x = 3
Worksheets("Sheet1").Range("A1:C5").Font.Bold = True
Worksheets("Sheet1").Range("A1:C1").Font.Underline = True
ProgressBar1.Visible = False
lngStop = Timer
lngTime = (lngStop - lngStart)
DoEvents
Label2.Caption = Format(lngTime, "##.000") & " Seconds"
Label2.BackColor = &HFFFF&
DoEvents
MsgBox ("That Took " & Format(lngTime, "##.000") & " Seconds")
'Close the connection
cnn.Close
Set cnn = Nothing
'Destroy the Recordset
Set rs = Nothing
Exit Sub
End Sub
Good Luck
Tk
damorrison Wrote
where in that code do you drop the actual macro?
|