I have put a modeless userform without caption as a childwindow into
the statusbar window of the main Exel window. So far so good. It moves
with the main excel window and stays fully functional inside the
statusbar.
My problem: When the main excel window is being resized in its width
then the statusbar window seems to be redrawn but not the userform
childwindow, and therefore the userform isn't visible anymore. I've
tried to use the resize event of the userform and as well the resize
event of the Excel application to make the userform being redrawn, but
both events seem to be called before the statusbar is being redrawn,
means it didn't solve the problem of my userform to disappear when the
excel window width is being changed.
Does anyone have experience working with the windows api in Excel/VBA
and how to work with setparent, setwindowpos, setwindowlong,
drawmenubar, and how to use them in order to solve my problem with the
excel statusbar?

What do you mean by "resize event of the Excel application". The application
doesn't expose such an event, only way (AFAIK) is with subclassing windows
events (risky in VBA) or a low level hook (much less risky but not risk
free).

Guess you have some other way I am unaware of, why not post your code.

Regards,
Peter T


"minimaster" wrote in message
...
I have put a modeless userform without caption as a childwindow into
the statusbar window of the main Exel window. So far so good. It moves
with the main excel window and stays fully functional inside the
statusbar.
My problem: When the main excel window is being resized in its width
then the statusbar window seems to be redrawn but not the userform
childwindow, and therefore the userform isn't visible anymore. I've
tried to use the resize event of the userform and as well the resize
event of the Excel application to make the userform being redrawn, but
both events seem to be called before the statusbar is being redrawn,
means it didn't solve the problem of my userform to disappear when the
excel window width is being changed.
Does anyone have experience working with the windows api in Excel/VBA
and how to work with setparent, setwindowpos, setwindowlong,
drawmenubar, and how to use them in order to solve my problem with the
excel statusbar?

I just checked it. You are correct. The application object does not
fire the WindowResize event, though it is listed in the VBA editor.
The WindowResize event is only working for the workbook object. But
using that one doesn't help either.
If there is no other way to make the userform stay visible then
probably I'll leave it to the user the restart the userform instead of
learning how to subclass the WndProc of the main excel window for the
time being.

Some relevant code from my userform module

Option Explicit
Option Base 1

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''
' Windows API Functions
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As
Long

Private Declare Function GetParent Lib "user32.dll" (ByVal hWnd As
Long) As Long

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 hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As
Long

Private Declare Function ReleaseCapture Lib "user32" () 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 SetWindowLong Lib "user32" Alias
"SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As
Long

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


Dim Buttons() As New clsLabelButton
'
Private Sub UserForm_Initialize()
' 1st ini
Call Set_UF_as_Statusbar_child
Call RemoveTitleBar
Call CreateButtons
Debug.Print "UF ini done"
End Sub

Private Sub CreateButtons()
Dim i As Integer
Dim lft As Integer

Const LastButton As Integer = 6

Me.BackColor = RGB(205, 225, 247)

For i = 1 To LastButton
ReDim Preserve Buttons(1 To i)
Set Buttons(i).LabelButton = Me.Controls.Add("Forms.Label.1")
With Buttons(i).LabelButton
.Left = lft + 2
.Height = 18
.BackColor = Me.BackColor
.PicturePosition = fmPicturePositionLeftCenter
Select Case i
Case LastButton
.ControlTipText = "VBA Editor"
.Tag = "VBA"
.Picture = FaceIDpic(1695)
.Width = 18
lft = lft + 18
Case 1
.ControlTipText = "show FaceID browser"
.Tag = "FaceIDs"
.Picture = FaceIDpic(417)
.Width = 18
lft = lft + 18
Case Else
.ControlTipText = "Button " & i
.Tag = "OnAction_Macro_Name " & i
.Picture = FaceIDpic(70 + i)
.Width = 18
lft = lft + 18
End Select

End With
Next i
With AdminLabel
.BackColor = Me.BackColor
.Left = lft
lft = lft + 18
.Width = 14
.Top = 0
.Tag = "Admin"
End With
ReDim Preserve Buttons(1 To LastButton + 1)
Set Buttons(i).LabelButton = AdminLabel
Me.Width = lft + 6

End Sub

Private Sub UserForm_Activate()
' Position userform
Me.Move (-Application.Left * 2 + 60)
Me.Height = 16
If Application.Version = "12.0" Then
Me.Top = 0
Else
Me.Top = -3
End If
End Sub

Private Sub UserForm_Resize()
Debug.Print "UF resize event!"
' putting anything here to redraw the userform didn't solve the
problem, same in Workbook object

End Sub

Private Sub UserForm_Terminate()
Debug.Print "TERMINATE"
Unload Me
End Sub

Private Sub RemoveTitleBar()
Const WS_CAPTION As Long = &HC00000
Const GWL_STYLE As Long = (-16)
Const WS_EX_WINDOWEDGE As Long = &H100
Const GWL_EXSTYLE As Long = (-20)
Const WS_CLIPCHILDREN = &H2000000
Const WS_CLIPSIBLINGS = &H4000000
Const WS_CHILD = &H40000000

' remove title
Call SetWindowLong(UserFormHWnd, GWL_STYLE, GetWindowLong
(UserFormHWnd, GWL_STYLE) And Not WS_CAPTION)
' remove frame
Call SetWindowLong(UserFormHWnd, GWL_EXSTYLE, GetWindowLong
(UserFormHWnd, GWL_STYLE) And WS_EX_WINDOWEDGE)

End Sub

Private Sub Set_UF_as_Statusbar_child()

Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame"
Const GA_ROOTOWNER As Long = 3&

Dim res As Long

Dim StatusbarWindow As String

If Application.Version = "12.0" Then
StatusbarWindow = "EXCEL2"
Debug.Print "We have Excel 12.0"
Else
StatusbarWindow = "EXCEL4"
End If

On Error GoTo errhdl
''''''''''''''''''''''''''''''
' Get the HWnd of the UserForm
''''''''''''''''''''''''''''''
UserFormHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption)
If UserFormHWnd 0 Then
''''''''''''''''''''''''
' Get the Statusbar HWnd
''''''''''''''''''''''''
StatHWnd = FindWindowEx(Application.hWnd, 0&, StatusbarWindow,
vbNullString)
If StatHWnd 0 Then
'''''''''''''''''''''''''''''''''
' Call SetParent to make the form
' a child of the Statusbar window.
'''''''''''''''''''''''''''''''''
res = SetParent(UserFormHWnd, StatHWnd)
If res < 0 Then
Exit Sub
End If
End If
End If
errhdl:
MsgBox "Error in: Set_UF_as_Statusbar_child !"
End Sub

I ran your code (had to add a withevents label class and declare one or two
variables) and all seems to work fine. No problem resizing the Excel main
window at all, the form and its labels remain in the resized statusbar.

However there's a big problem if Excel is minimized, cannot recover it from
the task bar until closing the form from the VBE, then 'Switch to' from the
task manager. I've come across this before, off the top of my head don't
recall the fix but pretty sure there is one.

Maybe it means hiding / reshowing the form as Excel is minimized / restored.
That would require something like the hook I mentioned, though no need to
subclass the main window's events.

Regards,
Peter T



"minimaster" wrote in message
...
I just checked it. You are correct. The application object does not
fire the WindowResize event, though it is listed in the VBA editor.
The WindowResize event is only working for the workbook object. But
using that one doesn't help either.
If there is no other way to make the userform stay visible then
probably I'll leave it to the user the restart the userform instead of
learning how to subclass the WndProc of the main excel window for the
time being.

Some relevant code from my userform module

Option Explicit
Option Base 1

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''
' Windows API Functions
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As
Long

Private Declare Function GetParent Lib "user32.dll" (ByVal hWnd As
Long) As Long

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 hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As
Long

Private Declare Function ReleaseCapture Lib "user32" () 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 SetWindowLong Lib "user32" Alias
"SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As
Long

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


Dim Buttons() As New clsLabelButton
'
Private Sub UserForm_Initialize()
' 1st ini
Call Set_UF_as_Statusbar_child
Call RemoveTitleBar
Call CreateButtons
Debug.Print "UF ini done"
End Sub

Private Sub CreateButtons()
Dim i As Integer
Dim lft As Integer

Const LastButton As Integer = 6

Me.BackColor = RGB(205, 225, 247)

For i = 1 To LastButton
ReDim Preserve Buttons(1 To i)
Set Buttons(i).LabelButton = Me.Controls.Add("Forms.Label.1")
With Buttons(i).LabelButton
.Left = lft + 2
.Height = 18
.BackColor = Me.BackColor
.PicturePosition = fmPicturePositionLeftCenter
Select Case i
Case LastButton
.ControlTipText = "VBA Editor"
.Tag = "VBA"
.Picture = FaceIDpic(1695)
.Width = 18
lft = lft + 18
Case 1
.ControlTipText = "show FaceID browser"
.Tag = "FaceIDs"
.Picture = FaceIDpic(417)
.Width = 18
lft = lft + 18
Case Else
.ControlTipText = "Button " & i
.Tag = "OnAction_Macro_Name " & i
.Picture = FaceIDpic(70 + i)
.Width = 18
lft = lft + 18
End Select

End With
Next i
With AdminLabel
.BackColor = Me.BackColor
.Left = lft
lft = lft + 18
.Width = 14
.Top = 0
.Tag = "Admin"
End With
ReDim Preserve Buttons(1 To LastButton + 1)
Set Buttons(i).LabelButton = AdminLabel
Me.Width = lft + 6

End Sub

Private Sub UserForm_Activate()
' Position userform
Me.Move (-Application.Left * 2 + 60)
Me.Height = 16
If Application.Version = "12.0" Then
Me.Top = 0
Else
Me.Top = -3
End If
End Sub

Private Sub UserForm_Resize()
Debug.Print "UF resize event!"
' putting anything here to redraw the userform didn't solve the
problem, same in Workbook object

End Sub

Private Sub UserForm_Terminate()
Debug.Print "TERMINATE"
Unload Me
End Sub

Private Sub RemoveTitleBar()
Const WS_CAPTION As Long = &HC00000
Const GWL_STYLE As Long = (-16)
Const WS_EX_WINDOWEDGE As Long = &H100
Const GWL_EXSTYLE As Long = (-20)
Const WS_CLIPCHILDREN = &H2000000
Const WS_CLIPSIBLINGS = &H4000000
Const WS_CHILD = &H40000000

' remove title
Call SetWindowLong(UserFormHWnd, GWL_STYLE, GetWindowLong
(UserFormHWnd, GWL_STYLE) And Not WS_CAPTION)
' remove frame
Call SetWindowLong(UserFormHWnd, GWL_EXSTYLE, GetWindowLong
(UserFormHWnd, GWL_STYLE) And WS_EX_WINDOWEDGE)

End Sub

Private Sub Set_UF_as_Statusbar_child()

Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame"
Const GA_ROOTOWNER As Long = 3&

Dim res As Long

Dim StatusbarWindow As String

If Application.Version = "12.0" Then
StatusbarWindow = "EXCEL2"
Debug.Print "We have Excel 12.0"
Else
StatusbarWindow = "EXCEL4"
End If

On Error GoTo errhdl
''''''''''''''''''''''''''''''
' Get the HWnd of the UserForm
''''''''''''''''''''''''''''''
UserFormHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption)
If UserFormHWnd 0 Then
''''''''''''''''''''''''
' Get the Statusbar HWnd
''''''''''''''''''''''''
StatHWnd = FindWindowEx(Application.hWnd, 0&, StatusbarWindow,
vbNullString)
If StatHWnd 0 Then
'''''''''''''''''''''''''''''''''
' Call SetParent to make the form
' a child of the Statusbar window.
'''''''''''''''''''''''''''''''''
res = SetParent(UserFormHWnd, StatHWnd)
If res < 0 Then
Exit Sub
End If
End If
End If
errhdl:
MsgBox "Error in: Set_UF_as_Statusbar_child !"
End Sub

I can confirm the problem with the minimized excel window. A rigth
click on the taskbar entry and then "restore" brings it back without
VBE/taskmanager involvement. Still not pretty at all. Another reason
to look at how to hook into the main excel window events.

Objective with this is to put the form in the Statusbar and solve the
problem described previously when Excel is minimized. Thanks are due to Karl
Peterson for the suggestion of the CBTProc as a way to trap Excel's Min/Max
events (many others too if needed, like resize, app activate/deactivate,
etc)

This is experimental to say the least, so test thoroughly. Code in a normal
module and in a form, with a button in top left corner. Also put two Forms
buttons on a sheet and assign macro to ShowForm & CloseFrm respectively. The
form must be shown modeless and unless you put a visible button in the form
(ie that will appear in the statusbar) with Unload Me you'll have no other
way to close the form.

Probably best also to call CloseFrm from the BeforeClose event

' Normal module
Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, ByVal nCode As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib _
"user32" (ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Const WH_CBT = 5

' CBT Hook Codes
'Private Const HCBT_MOVESIZE = 0
Private Const HCBT_MINMAX = 1
'Private Const HCBT_QS = 2
'Private Const HCBT_CREATEWND = 3
'Private Const HCBT_DESTROYWND = 4
'Private Const HCBT_ACTIVATE = 5
'Private Const HCBT_CLICKSKIPPED = 6
'Private Const HCBT_KEYSKIPPED = 7
'Private Const HCBT_SYSCOMMAND = 8
'Private Const HCBT_SETFOCUS = 9

' Window State Values
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_RESTORE = 9

Private m_hHook As Long
Public ghWndForm As Long
Public ghWndBar As Long
Public gHwndApp As Long
Private mbIsMinimized As Boolean

Private mFrm As UserForm1

Sub ShowForm()
Application.DisplayStatusBar = True

gHwndApp = Application.hWnd ' need FindWindow XLMAIN in Excel 2000
Set mFrm = New UserForm1
mFrm.Show vbModeless

HookCBT

End Sub

Sub CloseFrm()

UnhookCBT

On Error Resume Next
If Not mFrm Is Nothing Then
Unload mFrm
End If

Set mFrm = Nothing
End Sub

Public Sub HookCBT()

Call UnhookCBT

m_hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, 0&,
GetCurrentThreadId())

End Sub

Public Sub UnhookCBT()
If m_hHook Then
Call UnhookWindowsHookEx(m_hHook)
m_hHook = 0
End If

End Sub

Private Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Dim bIsMin As Boolean, b As Boolean
Dim nRet As Long

On Error Resume Next
b = Len(mFrm.Caption)
On Error GoTo 0

If b And (wParam = gHwndApp) Then
If nCode = HCBT_MINMAX Then
If WordLo(lParam) = SW_MINIMIZE Then
bIsMin = True
Else
bIsMin = False
End If

If bIsMin < mbIsMinimized Then
mbIsMinimized = bIsMin
mFrm.AttachToBar (Not mbIsMinimized)
If bIsMin Then
mFrm.Hide
Else
mFrm.Show vbModeless
' mFrm.PosForm
End If
End If

End If
End If

CBTProc = CallNextHookEx(m_hHook, nCode, wParam, lParam)

End Function

Private Function WordLo(ByVal LongIn As Long) As Integer
' Low word retrieved by masking off high word.
' If low word is too large, twiddle sign bit.
If (LongIn And &HFFFF&) &H7FFF Then
WordLo = (LongIn And &HFFFF&) - &H10000
Else
WordLo = LongIn And &HFFFF&
End If
End Function

'' end normal module

' Userform
' put a fairly thin button at top left of the form

Option Explicit
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long

Private Declare Function GetParent Lib "user32.dll" ( _
ByVal hWnd As Long) As Long

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 hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) 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 GetWindowLong Lib "user32" Alias _
"GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long

Private Const GWL_HWNDPARENT As Long = -8
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_EX_WINDOWEDGE As Long = &H100


Private mhWndForm As Long
Private mhWndBar As Long
Private mVer As Long
Dim mbOnBar As Boolean


Private Sub RemoveTitleBar()

Dim lStyle As Long
' remove title
lStyle = GetWindowLong(ghWndForm, GWL_STYLE)
lStyle = lStyle And Not WS_CAPTION
SetWindowLong ghWndForm, GWL_STYLE, lStyle

' remove frame
lStyle = GetWindowLong(ghWndForm, GWL_EXSTYLE)
lStyle = lStyle And WS_EX_WINDOWEDGE
SetWindowLong ghWndForm, GWL_EXSTYLE, lStyle

DrawMenuBar ghWndForm
End Sub

Public Sub AttachToBar(bToBar As Boolean)
Dim hWndP As Long, res As Long

If bToBar Then hWndP = mhWndBar Else hWndP = Application.hWnd

res = SetParent(ghWndForm, hWndP)
res = SetWindowLong(ghWndForm, GWL_HWNDPARENT, hWndP)

End Sub
Public Sub PosForm()
Me.Move (-Application.Left * 2 + 60)
Me.Height = 16
If mVer = 12 Then
Me.Top = 0
Else
Me.Top = -3
End If
End Sub
Private Sub CommandButton1_Click()

' Unload Me
MsgBox "Hello from Status Bar"
End Sub

Private Sub UserForm_Activate()

PosForm
End Sub

Private Sub UserForm_Initialize()
Dim sBarClass As String

Me.Caption = Now
ghWndForm = FindWindow("ThunderDFrame", Me.Caption)

Me.Caption = ghWndForm

mVer = Val(Application.Version)
If mVer = 12 Then
sBarClass = "EXCEL2"
Else
sBarClass = "EXCEL4"
End If

' Assumes 2002+
mhWndBar = FindWindowEx(Application.hWnd, 0&, sBarClass, vbNullString)

RemoveTitleBar

AttachToBar True

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UnhookCBT
End Sub

'''''''' end Userform

You may notice I changed some aspects of your API code.

Regards,
Peter T





"minimaster" wrote in message
...
I can confirm the problem with the minimized excel window. A rigth
click on the taskbar entry and then "restore" brings it back without
VBE/taskmanager involvement. Still not pretty at all. Another reason
to look at how to hook into the main excel window events.