need a progress bar for status bar

Hi

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

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

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

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

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]...
>
> Hi
>
> I need a progress bar that will be used in the status bar. Something
> like the one that runs when you open a really big workbook or one like
> when it calculates your worksheets. Is there any vba code that would do
> this jobe nicely. I know the application.statusbar.value = "Creating
> sheets" but would perfer a more meaningful % complete.
>
> I am using excel 2000 but my client will most likely be using excel 97.
>
>
> --
> funkymonkUK
> ------------------------------------------------------------------------
> funkymonkUK's Profile:
> http://www.excelforum.com/member.php...o&userid=18135
> View this thread: http://www.excelforum.com/showthread...hreadid=524257
>

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" wrote:

> 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
>
> --
> Regards,
> Tom Ogilvy
>
>
> "funkymonkUK" wrote:
>
> >
> > Hi
> >
> > I need a progress bar that will be used in the status bar. Something
> > like the one that runs when you open a really big workbook or one like
> > when it calculates your worksheets. Is there any vba code that would do
> > this jobe nicely. I know the application.statusbar.value = "Creating
> > sheets" but would perfer a more meaningful % complete.
> >
> > I am using excel 2000 but my client will most likely be using excel 97.
> >
> >
> > --
> > funkymonkUK
> > ------------------------------------------------------------------------
> > funkymonkUK's Profile: http://www.excelforum.com/member.php...o&userid=18135
> > View this thread: http://www.excelforum.com/showthread...hreadid=524257
> >
> >

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

--
Regards,
Tom Ogilvy


"funkymonkUK" wrote:

>
> Hi
>
> I need a progress bar that will be used in the status bar. Something
> like the one that runs when you open a really big workbook or one like
> when it calculates your worksheets. Is there any vba code that would do
> this jobe nicely. I know the application.statusbar.value = "Creating
> sheets" but would perfer a more meaningful % complete.
>
> I am using excel 2000 but my client will most likely be using excel 97.
>
>
> --
> funkymonkUK
> ------------------------------------------------------------------------
> funkymonkUK's Profile: http://www.excelforum.com/member.php...o&userid=18135
> View this thread: http://www.excelforum.com/showthread...hreadid=524257
>
>

Originally Posted by 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

"

thanks the demo seems to work however how do I incorporate it into my 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 that 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

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.

--
Regards,
Tom Ogilvy


"Henrich" wrote:

> 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" wrote:
>
> > 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
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> > "funkymonkUK" wrote:
> >
> > >
> > > Hi
> > >
> > > I need a progress bar that will be used in the status bar. Something
> > > like the one that runs when you open a really big workbook or one like
> > > when it calculates your worksheets. Is there any vba code that would do
> > > this jobe nicely. I know the application.statusbar.value = "Creating
> > > sheets" but would perfer a more meaningful % complete.
> > >
> > > I am using excel 2000 but my client will most likely be using excel 97.
> > >
> > >
> > > --
> > > funkymonkUK
> > > ------------------------------------------------------------------------
> > > funkymonkUK's Profile: http://www.excelforum.com/member.php...o&userid=18135
> > > View this thread: http://www.excelforum.com/showthread...hreadid=524257
> > >
> > >

Originally Posted by funkymonkUK

thanks the demo seems to work however how do I incorporate it into my 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 that 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?

somebody please help me.

Dim PB as clsProgBar
Set PB = New clsProgBar

With PB

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

End With

>> ' This composes the Old and New Data to run in one easy step
>> Application.ScreenUpdating = False
>> Sheets("Temp").Visible = True
>> getolddata
PB.Caption1 = "Getting current year's figures"
PB.Progress = 50

>> getnewdata ' within this one there is three sections that run
PB.Finish
Set PB = Nothing
>> Application.ScreenUpdating = True
>> Sheets("Temp").Visible = False
>> Sheets("main").Select
>> MsgBox "Report is complete.", vbInformation
>> End Sub



--
Robin Hammond
www.enhanceddatasystems.com
"funkymonkUK" <[email protected]>
wrote in message
news:[email protected]...
>
> funkymonkUK Wrote:
>> thanks the demo seems to work however how do I incorporate it into my
>> 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 that
>> 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
> ------------------------------------------------------------------------
> funkymonkUK's Profile:
> http://www.excelforum.com/member.php...o&userid=18135
> View this thread: http://www.excelforum.com/showthread...hreadid=524257
>

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

"Robin Hammond" wrote:

> Dim PB as clsProgBar
> Set PB = New clsProgBar
>
> With PB
>
> .Title = "Processing"
> .Caption1 = "Getting last year's figures"
> .Show
>
> End With
>
> >> ' This composes the Old and New Data to run in one easy step
> >> Application.ScreenUpdating = False
> >> Sheets("Temp").Visible = True
> >> getolddata
> PB.Caption1 = "Getting current year's figures"
> PB.Progress = 50
>
> >> getnewdata ' within this one there is three sections that run
> PB.Finish
> Set PB = Nothing
> >> Application.ScreenUpdating = True
> >> Sheets("Temp").Visible = False
> >> Sheets("main").Select
> >> MsgBox "Report is complete.", vbInformation
> >> End Sub
>
>
>
> --
> Robin Hammond
> www.enhanceddatasystems.com
> "funkymonkUK" <[email protected]>
> wrote in message
> news:[email protected]...
> >
> > funkymonkUK Wrote:
> >> thanks the demo seems to work however how do I incorporate it into my
> >> 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 that
> >> 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
> > ------------------------------------------------------------------------
> > funkymonkUK's Profile:
> > http://www.excelforum.com/member.php...o&userid=18135
> > View this thread: http://www.excelforum.com/showthread...hreadid=524257
> >
>
>
>