Thread: Progress Bar
View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
TK TK is offline
external usenet poster
 
Posts: 177
Default 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?