need a progress bar for status bar

[funkymonkUK]

Hi

I need a progress bar that will be used in the status bar. Somethin
like the one that runs when you open a really big workbook or one lik
when it calculates your worksheets. Is there any vba code that would d
this jobe nicely. I know the application.statusbar.value = "Creatin
sheets" but would perfer a more meaningful % complete.

I am using excel 2000 but my client will most likely be using excel 97

 

[funkymonkUK]

i know there was a way as it used to be under the Excel Tips menu bu
now it just seems to be empty

 

[SpiderSwamy]

Hi i used the following code to clear my sheet at the same time i din't
wanted my application screen to be static, so i introduced a progress
bar which counts from 0 % to 100% and then ask just a moment to display
result modify the progress bar code as u r requirement.

For I = 1 To 501
For J = 1 To 7
mywb.Sheets("Sheet1").Cells(I, J).Value = Null
MousePointer = vbHourglass
Next

Picture1.AutoRedraw = True
Picture1.BackColor = vbWhite
Picture1.ForeColor = vbBlue
Picture1.ScaleWidth = 100
Picture1.DrawMode = vbNotXorPen
direction = 1
Timer1.Interval = delay
Timer1.Enabled = True

'for progress bar

Static progress As Long
Dim txt As String

If direction = 1 Then
progress = progress + barStep
If progress > Picture1.ScaleWidth - barWidth Then
progress = Picture1.ScaleWidth - barWidth
direction = -1
End If
Else
progress = progress - barStep
If progress < 0 Then
progress = 0
direction = 1
End If
End If
If (k < 100) Then
k = k + 1
txt = k & "%"
Picture1.Cls
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(txt))
\ 2
Picture1.CurrentY = (Picture1.ScaleHeight -
Picture1.TextHeight(txt)) \ 2
Picture1.Print txt$
Else
' if it takes more than 100 loop
txt = "One moment please..." ' txt = k & "%" '
Picture1.Cls
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(txt))
\ 2
Picture1.CurrentY = (Picture1.ScaleHeight -
Picture1.TextHeight(txt)) \ 2
Picture1.Print txt$
'Picture1.Line (progress, 0)-(progress + barWidth,
Picture1.ScaleHeight), Picture1.ForeColor, BF
End If

 

[Robin Hammond]

There's one on my site that runs in the status bar for 97 and as a proper
form in 2000.

Robin Hammond
www.enhanceddatasystems.com

"funkymonkUK" <[email protected]>
wrote in message
news:[email protected]...

 

[Henrich]

Hi Tom,

the progress bar is working, but how to achieve that while my code will run
the progress bar is growing till 100% exactly the same time?

For example my code is opening another workbooks, get some data, then close
these workbooks. So I want to achieve that while these action are
administrated the progress bar will exactly that time grow?

 

[Tom Ogilvy]

Michel Pierron posted this awhile ago:

Private Declare Function FindWindow& Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function CreateWindowEX& Lib "user32" Alias _
"CreateWindowExA" (ByVal dwExStyle&, ByVal lpClassName$ _
, ByVal lpWindowName$, ByVal dwStyle&, ByVal x&, ByVal y& _
, ByVal nWidth&, ByVal nHeight&, ByVal hWndParent& _
, ByVal hMenu&, ByVal hInstance&, lpParam As Any)
Private Declare Function DestroyWindow& Lib "user32" (ByVal hWnd&)
Private Declare Function SendMessage& Lib "user32" Alias _
"SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)
Private Declare Function GetClientRect& Lib "user32" _
(ByVal hWnd&, lpRect As RECT)
Private Declare Function FindWindowEx& Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1&, ByVal hWnd2&, ByVal lpsz1$, ByVal lpsz2$)

Private Type RECT
cl As Long
ct As Long
cr As Long
cb As Long
End Type

Sub PBarDraw()
Dim BarState As Boolean
Dim hWnd&, pbhWnd&, y&, h&, i&, R As RECT
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
GetClientRect hWnd, R
h = (R.cb - R.ct) - 6: y = R.ct + 3
pbhWnd = CreateWindowEX(0, "msctls_progress32", "" _
, &H50000000, 35, y, 185, h, hWnd, 0&, 0&, 0&)
SendMessage pbhWnd, &H409, 0, ByVal RGB(0, 0, 125)
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
For i = 1 To 50000
DoEvents
Application.StatusBar = Format(i / 50000, "0%")
SendMessage pbhWnd, &H402, Val(Application.StatusBar), 0
Next i
DestroyWindow pbhWnd
Application.StatusBar = False
Application.DisplayStatusBar = BarState
End Sub

 

[funkymonkUK]

There's one on my site that runs in the status bar for 97 and as
proper
form in 2000.

Robin Hammond
www.enhanceddatasystems.com

"

thanks the demo seems to work however how do I incorporate it into m
coding?

I do not have a loop

this is my main sub

' This composes the Old and New Data to run in one easy step
Application.ScreenUpdating = False
Sheets("Temp").Visible = True
Application.StatusBar = "Getting Last Years Figures"
getolddata
Application.StatusBar = "Getting Current Years Figures"
getnewdata
Application.StatusBar = False
Application.ScreenUpdating = True
Sheets("Temp").Visible = False
Sheets("main").Select
MsgBox "Report is complete.", vbInformation
End Su

 

[Tom Ogilvy]

have you written the code to update the progress bar?

If you have and still don't see it, then add in a

Applicaton.ScreenUpdating = True

and/or Doevents

after updating it.

 

[funkymonkUK]

thanks the demo seems to work however how do I incorporate it into m
coding?

I do not have a loop

this is my main sub

' This composes the Old and New Data to run in one easy step
Application.ScreenUpdating = False
Sheets("Temp").Visible = True
Application.StatusBar = "Getting Last Years Figures"
getolddata ' within this one there is three sections tha
run
Application.StatusBar = "Getting Current Years Figures"
getnewdata ' within this one there is three sections that run
Application.StatusBar = False
Application.ScreenUpdating = True
Sheets("Temp").Visible = False
Sheets("main").Select
MsgBox "Report is complete.", vbInformation
End Sub

any ideas

 

[funkymonkUK]

somebody please help me.

 

[Robin Hammond]

Dim PB as clsProgBar
Set PB = New clsProgBar

With PB

.Title = "Processing"
.Caption1 = "Getting last year's figures"
.Show

End With
PB.Caption1 = "Getting current year's figures"
PB.Progress = 50
PB.Finish
Set PB = Nothing

 

[Henrich]

Hi Robin,

your code just work like a charm, it take me a time to understand your code
and how to implement it but after your last reply is now everything working
well. THANKS A LOT

Henrich