Anyone know how to get the handle of the statusbar in Excel 2007? For
earlier versions I'm using:

Dim hThis As Long
hThis = FindWindow(vbNullString, ThisWorkbook.Caption)

Dim hExcel4 As Long
hExcel4 = FindWindowEx(hThis, 0, "EXCEL4", vbNullString)

Thanks,
Jamie.

--

Jamie,

From Winspector, the class of the status bar seems to be Excel2 now, which
is a pain.

This seems to work

Dim hThis As Long
Dim hExcel2 As Long
Dim hStatus As Long

hThis = FindWindow("XLMAIN", Application.Caption)

hExcel2 = FindWindowEx(hThis, 0&, "EXCEL2", vbNullString)

hStatus = FindWindowEx(hExcel2, 0&, "MsoCommandBar", "Status Bar")

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"Jamie Collins" wrote in message
oups.com...
Anyone know how to get the handle of the statusbar in Excel 2007? For
earlier versions I'm using:

Dim hThis As Long
hThis = FindWindow(vbNullString, ThisWorkbook.Caption)

Dim hExcel4 As Long
hExcel4 = FindWindowEx(hThis, 0, "EXCEL4", vbNullString)

Thanks,
Jamie.

--

On Jul 2, 1:56 pm, "Bob Phillips" wrote:
Jamie,

From Winspector, the class of the status bar seems to be Excel2 now, which
is a pain.

This seems to work

Dim hThis As Long
Dim hExcel2 As Long
Dim hStatus As Long

hThis = FindWindow("XLMAIN", Application.Caption)

hExcel2 = FindWindowEx(hThis, 0&, "EXCEL2", vbNullString)

hStatus = FindWindowEx(hExcel2, 0&, "MsoCommandBar", "Status Bar")

Thanks Bob. Works for me too!

Jamie.

--

For my interest Jamie, what do you need the handle of the status bar for?

Bob

"Jamie Collins" wrote in message
ups.com...
On Jul 2, 1:56 pm, "Bob Phillips" wrote:
Jamie,

From Winspector, the class of the status bar seems to be Excel2 now,
which
is a pain.

This seems to work

Dim hThis As Long
Dim hExcel2 As Long
Dim hStatus As Long

hThis = FindWindow("XLMAIN", Application.Caption)

hExcel2 = FindWindowEx(hThis, 0&, "EXCEL2", vbNullString)

hStatus = FindWindowEx(hExcel2, 0&, "MsoCommandBar", "Status Bar")

Thanks Bob. Works for me too!

Jamie.

--

On Jul 2, 3:35 pm, "Bob Phillips" wrote:
For my interest Jamie, what do you need the handle of the status bar for?

To create 'stacked' progress bars.

Jamie.

--

Interesting. Is this for a work project, or will you publish to the world? I
did a stacked progress bar recently, on a form, but the status bar would be
nice (didn't even think of that).

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"Jamie Collins" wrote in message
ups.com...
On Jul 2, 3:35 pm, "Bob Phillips" wrote:
For my interest Jamie, what do you need the handle of the status bar for?

To create 'stacked' progress bars.

Jamie.

--

"Bob Phillips" wrote:

will you publish to the world? I
did a stacked progress bar recently, on a form, but the status bar would be
nice (didn't even think of that).

All the usual disclaimers apply (€œ...quite a while ago...not well
maintained... hard-coded assumptions...would do it differently now...€�):

'---<Example usage---
Private Sub TestBars()

Dim bar1 As CExcelProgressbar
Set bar1 = New CExcelProgressbar

Dim bar2 As CExcelProgressbar
Set bar2 = New CExcelProgressbar

bar1.Init _
"Doing stuff", , , _
RGB(125, 195, 195), , True, _
wpBorderStyleNone, wpAppearance3D

bar2.Init _
, 300, , _
RGB(204, 134, 0), , False, _
wpBorderStyleFixedSingle, wpAppearanceFlat

Dim i As Long
For i = 1 To 1000000
bar1.Update i / 10000
Next

For i = 1 To 1000000
bar2.Update i / 10000
Next

For i = 1 To 1000000
Next

Set bar1 = Nothing
Set bar2 = Nothing

End Sub
'---</Example usage---

'---<class: CExcelProgressbar---
Option Explicit

Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long

Private Declare Function GetTextExtentPoint32 _
Lib "gdi32" Alias "GetTextExtentPoint32A" _
(ByVal hdc As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type

Private Type Size
cx As Long
cy As Long
End Type

Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx _
Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function GetClientRect _
Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Approx equal to Excel's when saving
Private Const WIDTH_DEFAULT As Long = 190

Private Const INDENT_DEFAULT As Long = 1

Private m_WindowProgressbar As CWindowProgressbar
Private m_blnInitialized As Boolean

Public Function Init( _
Optional ByVal InitialMessage As String, _
Optional ByVal Indent As Long, _
Optional ByVal Width As Long = WIDTH_DEFAULT, _
Optional ByVal ForeColor As Variant = wpColorUseDefault, _
Optional ByVal BackColor As Variant = wpColorUseDefault, _
Optional ByVal SmoothBackground As Boolean = False, _
Optional ByVal BorderStyle As wpBorderStyleEnum =
wpBorderStyleFixedSingle, _
Optional ByVal Appearance As wpAppearanceEnum = wpAppearanceFlat _
) As Boolean


With Excel.Application

' Get hWnd for Excel's statusbar
Dim hThis As Long
hThis = FindWindow(vbNullString, .Caption)

Dim hExcel4 As Long
hExcel4 = FindWindowEx(hThis, 0, "EXCEL4", vbNullString)
If hExcel4 = 0 Then
hExcel4 = FindWindowEx(hThis, 0&, "EXCEL2", vbNullString)
End If

' Width
Dim lngWidth As Long
If Width <= 0 Then
lngWidth = WIDTH_DEFAULT
Else
lngWidth = Width
End If

' Indent
Dim lngIndent As Long
lngIndent = Indent
If lngIndent < 0 Then
lngIndent = 0
End If

If lngIndent = 0 Then
If Len(InitialMessage) = 0 Then
lngIndent = INDENT_DEFAULT
Else

' No explicit indent value so indent to
' fit initial message text
Dim hdc As Long
Dim TextMetricsStruct As TEXTMETRIC
Dim TextSize As Size
hdc = GetDC(hExcel4)
GetTextExtentPoint32 _
hdc, InitialMessage, Len(InitialMessage), _
TextSize

' Add margin between text and progressbar
lngIndent = lngIndent + TextSize.cx + 12
ReleaseDC hExcel4, hdc
End If
End If

' Get rect for Excel's statusbar
Dim rExcel4 As RECT
GetClientRect hExcel4, rExcel4

' Position
Dim lngHeight As Long
Dim lngTop As Long
lngHeight = rExcel4.Bottom - rExcel4.Top - 8
lngTop = rExcel4.Top + 5

' Show message in Excel's statusbar
If Len(InitialMessage) 0 Then
.StatusBar = InitialMessage
End If
End With

Set m_WindowProgressbar = New CWindowProgressbar
Init = m_WindowProgressbar.Init( _
hExcel4, lngIndent, lngTop, lngWidth, lngHeight, _
ForeColor, BackColor, SmoothBackground, _
BorderStyle, Appearance)

m_blnInitialized = True

End Function

Public Function Update( _
Optional ByVal ProgressPercentage As Long = 100, _
Optional ByVal MessageText As Variant, _
Optional ByVal ForeColor As Variant = wpColorUseExisting _
) As Boolean

If Not m_blnInitialized Then
Init MessageText, , , ForeColor
End If

If Not IsMissing(MessageText) Then
Excel.Application.StatusBar = MessageText
End If

Update = m_WindowProgressbar.Update( _
ProgressPercentage, ForeColor)

End Function

Private Sub Class_Terminate()
Excel.Application.StatusBar = False
End Sub
'---</class: CExcelProgressbar---

'---<class: CUserformProgressbar---
Option Explicit

' --- <Win32 API declarations ---
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetDC Lib "user32" ( _
ByVal hWnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hdc As Long) As Long

Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
' --- </Win32 API declarations ---

Private Const WIDTH_DEFAULT As Long = 93
Private Const HEIGHT_DEFAULT As Long = 10

Private m_WindowProgressbar As CWindowProgressbar

Public Function Init( _
Optional ByVal UserformInstance As Object, _
Optional ByVal Left As Long, _
Optional ByVal Top As Long, _
Optional ByVal Width As Long = WIDTH_DEFAULT, _
Optional ByVal Height As Long = HEIGHT_DEFAULT, _
Optional ByVal ForeColor As Variant = wpColorUseDefault, _
Optional ByVal BackColor As Variant = wpColorUseDefault, _
Optional ByVal SmoothBackground As Boolean = False, _
Optional ByVal BorderStyle As wpBorderStyleEnum =
wpBorderStyleFixedSingle, _
Optional ByVal Appearance As wpAppearanceEnum = wpAppearanceFlat _
) As Boolean

Dim oUserform As MSForms.UserForm
On Error Resume Next
Set oUserform = UserformInstance
On Error GoTo 0
If oUserform Is Nothing Then
Exit Function
End If

Set m_WindowProgressbar = New CWindowProgressbar

Init = m_WindowProgressbar.Init(hWnd(UserformInstance), _
Left / PointsPerPixelX, Top / PointsPerPixelY, _
Width / PointsPerPixelX, Height / PointsPerPixelY, _
ForeColor, BackColor, SmoothBackground, BorderStyle, Appearance)

End Function

Public Function Update( _
Optional ByVal ProgressPercentage As Long = 100, _
Optional ByVal ForeColor As Variant = wpColorUseExisting _
) As Boolean
m_WindowProgressbar.Update ProgressPercentage, ForeColor
End Function

Private Property Get hWnd(ByVal UserformInstance As Object) As Long
hWnd = FindWindow("ThunderDFrame", UserformInstance.Caption)
End Property

Private Property Get PointsPerPixelX() As Double
Dim hdc As Long
hdc = GetDC(0)
PointsPerPixelX = 72 / GetDeviceCaps(hdc, LOGPIXELSX)
ReleaseDC 0, hdc
End Property

Private Property Get PointsPerPixelY() As Double
Dim hdc As Long
hdc = GetDC(0)
PointsPerPixelY = 72 / GetDeviceCaps(hdc, LOGPIXELSY)
ReleaseDC 0, hdc
End Property
'---</class: CUserformProgressbar---

'---<class: CWindowProgressbar---
Option Explicit

Private Declare Function SetWindowPos _
Lib "user32" (ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, ByVal X As Long, _
ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long

Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
Long

Private Declare Function CreateWindowEx _
Lib "user32" Alias "CreateWindowExA" _
(ByVal lngStyleEx As Long, ByVal lpClassName As String, _
ByVal lpWindowName As String, ByVal lngStyle As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hWndParent As Long, _
ByVal hMenu As Long, ByVal hInstance As Long, _
lpParam As Any) As Long

Private Declare Function DestroyWindow _
Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetClientRect _
Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_CHILD As Long = &H40000000
Private Const WS_BORDER As Long = &H800000

Private Const WM_USER As Long = &H400
Private Const PBM_SETBARCOLOR As Long = WM_USER + 9
Private Const PBM_SETBKCOLOR As Long = &H2001
Private Const PBM_SETPOS As Long = WM_USER + 2
Private Const PBS_SMOOTH As Long = 1
Private Const PBS_MARQUEE As Long = 8

Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const SWP_NOOWNERZORDER As Long = &H200
Private Const SWP_NOREPOSITION As Long = SWP_NOOWNERZORDER
Private Const SWP_NOZORDER As Long = &H4
Private Const WS_EX_CLIENTEDGE As Long = &H200&
Private Const WS_EX_WINDOWEDGE As Long = &H100&
Private Const WS_EX_STATICEDGE As Long = &H20000
Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)

Private Const PROGRESS_CLASS_NAME As String = _
"msctls_progress32"

Public Enum wpColorEnum
wpColorUseDefault = -3
wpColorUseExisting = -2
End Enum

Public Enum wpBorderStyleEnum
wpBorderStyleNone = 0
wpBorderStyleFixedSingle = 1
End Enum

Public Enum wpAppearanceEnum
wpAppearanceFlat = 0
wpAppearance3D = 1
End Enum

' Retain progressbar hWnd
Private m_hProgress As Long

' Approx equal to Excel's when saving
Private Const WIDTH_DEFAULT As Long = 93

Private Const HEIGHT_DEFAULT As Long = 10

' Default bar to blue
Private Const COLOR_DEFAULT_FORE As Long = 8388608

'' Default backcolor to gray
'Private Const COLOR_DEFAULT_BACK As Long = 13160660

Private m_lngProgressPercentage As Long

Public Function Init( _
Optional ByVal hWnd As Long, _
Optional ByVal Left As Long, _
Optional ByVal Top As Long, _
Optional ByVal Width As Long = WIDTH_DEFAULT, _
Optional ByVal Height As Long = HEIGHT_DEFAULT, _
Optional ByVal ForeColor As Variant = wpColorUseDefault, _
Optional ByVal BackColor As Variant = wpColorUseDefault, _
Optional ByVal SmoothBackground As Boolean = False, _
Optional ByVal BorderStyle As wpBorderStyleEnum =
wpBorderStyleFixedSingle, _
Optional ByVal Appearance As wpAppearanceEnum = wpAppearanceFlat _
) As Boolean

' Remove existing progressbar
If m_hProgress < 0 Then
Remove
End If

' Width
If Width <= 0 Then
Width = WIDTH_DEFAULT
End If

' Height
If Height < 0 Then
Height = HEIGHT_DEFAULT
End If

' Get rect for window
Dim rWnd As RECT
GetClientRect hWnd, rWnd

' Left
Dim lngLeft As Long
If Left < 0 Then
lngLeft = rWnd.Right + Left
Else
lngLeft = rWnd.Left + Left
End If

' Top
Dim lngTop As Long
If Top < 0 Then
lngTop = rWnd.Bottom + Top
Else
lngTop = rWnd.Top + Top
End If

' Progressbar's style
Dim lngStyleProgress As Long
lngStyleProgress = WS_VISIBLE Or WS_CHILD
If SmoothBackground Then
lngStyleProgress = lngStyleProgress Or PBS_SMOOTH
Else
lngStyleProgress = lngStyleProgress Or PBS_MARQUEE
End If

' Create progressbar window
m_hProgress = _
CreateWindowEx(0, PROGRESS_CLASS_NAME, _
vbNullString, lngStyleProgress, lngLeft, _
lngTop, Width, Height, hWnd, 0, 0, 0)

' Change progressbar's appearance/border
Dim lngStyle As Long
Dim lngStyleEx As Long
Dim lngFrameChangedOnly As Long
lngStyle = GetWindowLong(m_hProgress, GWL_STYLE)
lngStyleEx = GetWindowLong(m_hProgress, GWL_EXSTYLE)

Select Case BorderStyle

Case wpBorderStyleNone
Select Case Appearance
Case wpAppearanceFlat
lngStyle = lngStyle And Not WS_BORDER
lngStyleEx = lngStyleEx Or WS_EX_WINDOWEDGE
lngStyleEx = lngStyleEx And Not WS_EX_STATICEDGE
lngStyleEx = lngStyleEx And Not WS_EX_CLIENTEDGE

Case wpAppearance3D
lngStyle = lngStyle And Not WS_BORDER
lngStyleEx = lngStyleEx And Not WS_EX_WINDOWEDGE
lngStyleEx = lngStyleEx Or WS_EX_STATICEDGE
lngStyleEx = lngStyleEx And Not WS_EX_CLIENTEDGE
End Select

Case wpBorderStyleFixedSingle
Select Case Appearance
Case wpAppearanceFlat
lngStyle = lngStyle Or WS_BORDER
lngStyleEx = lngStyleEx And Not WS_EX_WINDOWEDGE
lngStyleEx = lngStyleEx And Not WS_EX_STATICEDGE
lngStyleEx = lngStyleEx And Not WS_EX_CLIENTEDGE

Case wpAppearance3D
lngStyle = lngStyle And Not WS_BORDER
lngStyleEx = lngStyleEx And Not WS_EX_WINDOWEDGE
lngStyleEx = lngStyleEx And Not WS_EX_STATICEDGE
lngStyleEx = lngStyleEx Or WS_EX_CLIENTEDGE
End Select
End Select

lngFrameChangedOnly = _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOREPOSITION _
Or SWP_NOZORDER Or SWP_FRAMECHANGED

SetWindowLong m_hProgress, GWL_STYLE, lngStyle
SetWindowLong m_hProgress, GWL_EXSTYLE, lngStyleEx
SetWindowPos _
m_hProgress, 0, 0, 0, 0, 0, lngFrameChangedOnly

' ForeColor
Dim lngForeColor As Long
lngForeColor = COLOR_DEFAULT_FORE
If Not IsEmpty(ForeColor) Then
If ForeColor < wpColorUseDefault Then
On Error Resume Next
lngForeColor = CLng(ForeColor)
On Error GoTo 0
End If
End If
If lngForeColor < RGB(0, 0, 0) _
Or lngForeColor RGB(255, 255, 255) Then
lngForeColor = COLOR_DEFAULT_FORE
End If
SendMessage _
m_hProgress, PBM_SETBARCOLOR, 1, _
ByVal lngForeColor

' BackColor
If BackColor < wpColorUseDefault Then
Dim lngBackColor As Long
If Not IsEmpty(BackColor) Then
On Error Resume Next
lngBackColor = CLng(BackColor)
On Error GoTo 0
End If
If lngBackColor = RGB(0, 0, 0) _
And lngBackColor <= RGB(255, 255, 255) Then
SendMessage _
m_hProgress, PBM_SETBKCOLOR, 1, _
ByVal lngBackColor
End If
End If

DoEvents

Init = True

End Function

Public Function Update( _
Optional ByVal ProgressPercentage As Long = 100, _
Optional ByVal ForeColor As Variant = wpColorUseExisting _
) As Boolean

If m_hProgress = 0 Then

Exit Function
End If

If m_lngProgressPercentage < ProgressPercentage Then
m_lngProgressPercentage = ProgressPercentage
SendMessage _
m_hProgress, PBM_SETPOS, _
ProgressPercentage, 0
Update = True
End If

' ForeColor
Dim lngForeColor As Long
If Not IsMissing(ForeColor) Then
If Not IsEmpty(ForeColor) Then
If ForeColor < wpColorUseExisting Then
lngForeColor = wpColorUseDefault
On Error Resume Next
lngForeColor = CLng(ForeColor)
On Error GoTo 0
If lngForeColor < RGB(0, 0, 0) _
Or lngForeColor RGB(255, 255, 255) Then
lngForeColor = COLOR_DEFAULT_FORE
End If

SendMessage _
m_hProgress, PBM_SETBARCOLOR, 1, _
ByVal lngForeColor

Update = True
End If
End If
End If

End Function

Private Sub Class_Terminate()
On Error Resume Next
Remove
DoEvents
End Sub

Private Function Remove() As Boolean
DestroyWindow m_hProgress
m_hProgress = 0
Remove = True
End Function

Public Property Get ProgressPercentage() As Long
ProgressPercentage = m_lngProgressPercentage
End Property
'---</class: CWindowProgressbar---

Jamie.

--