ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Userform as childwindow in statusbar not redrawn when Excel window isresized (https://www.excelbanter.com/excel-programming/438364-userform-childwindow-statusbar-not-redrawn-when-excel-window-isresized.html)

minimaster
Userform as childwindow in statusbar not redrawn when Excel window isresized
 
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?

Peter T
Userform as childwindow in statusbar not redrawn when Excel window is resized
 
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?



minimaster
Userform as childwindow in statusbar not redrawn when Excelwindow is resized
 
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

Peter T
Userform as childwindow in statusbar not redrawn when Excel window is resized
 
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

minimaster
Userform as childwindow in statusbar not redrawn when Excelwindow is resized
 
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.

Peter T
Userform as childwindow in statusbar not redrawn when Excel window is resized
 
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.



minimaster
Userform as childwindow in statusbar not redrawn when Excelwindow is resized
 
Thank you, that is quite helpful. I already looked at this method in
the VB group disccusion were you were involved in December.

I do find it weird that your userform stays visible when doing a
resize of the window width (height alone is good) and on my PC the UF
window isn't visible after the width resize. When I use getwindowrect
it still delivers the coordinates of the UF window, though it isn't
visible. What does this mean?

Peter T
Userform as childwindow in statusbar not redrawn when Excel window is resized
 
"minimaster" wrote in message
Thank you, that is quite helpful. I already looked at this method in
the VB group disccusion were you were involved in December.

Only quite!
Seriously though, this may be the first time a semi-safe method of trapping
Excel's min/restore events (& some others) has been posted in an Excel
group. The code as posted is a very basic implementation, just enough to
overcome poblem when mininized; the method has a lot more possibilites.

I do find it weird that your userform stays visible when doing a
resize of the window width (height alone is good) and on my PC the UF
window isn't visible after the width resize.

Are you talking about the code I posted or what I said about recreating your
code and all seemed OK with it (form remains in same position in the status
bar window after resizing Excel).

If you mean my version of your code, I had to change a few things and add
some more to get it to work, maybe those differences account for it worked.
If you mean the code I posted works for me but not for you (form gets lost
after resize) I have no idea. I tested in both 2003 & 2007 and it worked
fine in both.

FWIW I'm not entirely happy about the positioning method (looks like an
empirical kludge), out of laziness I used your approach but I suspect it's
worth looking at that again. Maybe SetWindowPos.

When I use getwindowrect
it still delivers the coordinates of the UF window, though it isn't
visible. What does this mean?

I don't understand the question, a window doesn't have to be visible for it
to exist, and if it exists and exposes a handle you can get its coordinates.

Regards,
Peter T

minimaster
Userform as childwindow in statusbar not redrawn when Excelwindow is resized
 
of course: - very helpful - sory for my german understatement
tendency.
I agree the CBT method is very stable in combination with a runing
VBE.

..I tested in both 2003 & 2007 and it worked fine in both.
Yes, I was referring to your comment #2 on Jan.13th. I started a new
workbook from scratch with your posting/code on Jan.14th but
immediatly had the resize problem. Annoying. Maybe I'll leave this
little problem alone for a while before I start to analyze the CBT
messages to see how I can implement there a way to ensure the I see
the UF after the resize.

... I'm not entirely happy about the positioning method
I agree with your comment about the positioning of the UF. It behaves
a bit strange. For the initial position it is -Application.left * 2 +
the offset to to the right. Afterwards when you switch the parent with
your code the factor must be *1 and not *2. Maybe setwindowsPos is
easier and better to predict. I didn't dig into that one yet.

Overall I'm happy to see that it is possible with this special UF
setup to simulate a commandbar at the bottom of the main Excel 2007
window, despite MS efforts to make us all use the ribbon interface
instead of the commandbars. The next challenge I'm interested in is to
"dock" such a userform on the left or the right side of the main Excel
window.

minimaster
Userform as childwindow in statusbar not redrawn when Excelwindow is resized
 
of course: - very helpful - sory for my german understatement
tendency.
I agree the CBT method is very stable in combination with a runing
VBE.

..I tested in both 2003 & 2007 and it worked fine in both.

Yes, I was referring to your comment #2 on Jan.13th. I started a new
workbook from scratch with your posting/code on Jan.14th but
immediatly had the resize problem. Annoying. Maybe I'll leave this
little problem alone for a while before I start to analyze the CBT
messages to see how I can implement there a way to ensure the I see
the UF after the resize.

... I'm not entirely happy about the positioning method

I agree with your comment about the positioning of the UF. It behaves
a bit strange. For the initial position it is -Application.left * 2 +
the offset to to the right. Afterwards when you switch the parent with
your code the factor must be *1 and not *2. Maybe setwindowsPos is
easier and better to predict. I didn't dig into that one yet.

Overall I'm happy to see that it is possible with this special UF
setup to simulate a commandbar at the bottom of the main Excel 2007
window, despite MS efforts to make us all use the ribbon interface
instead of the commandbars. The next challenge I'm interested in is to
"dock" such a userform on the left or the right side of the main Excel
window.

...if it exists and exposes a handle you can get its coordinates.
Yes correct, and therefore it shouldn't be too difficult to make it
visible after the resize.

Peter T
Userform as childwindow in statusbar not redrawn when Excel window is resized
 
"minimaster" wrote in message
of course: - very helpful - sory for my german understatement
tendency.

No need to apologise, we British understand understatement <g

I agree the CBT method is very stable in combination with a runing
VBE.

It's much more stable and less resource intensive that subclassing windows
events, however absolutely must not do anything that would cause the code to
recompile, otherwise Excel will crash! So don't edit the project while the
hook is running.

One small thing, all the dropdown palette icons seem to flicker a bit in
2003-

..I tested in both 2003 & 2007 and it worked fine in both.

Yes, I was referring to your comment #2 on Jan.13th. I started a new
workbook from scratch with your posting/code on Jan.14th but
immediatly had the resize problem. Annoying. Maybe I'll leave this
little problem alone for a while before I start to analyze the CBT
messages to see how I can implement there a way to ensure the I see
the UF after the resize.

Lot's of potential there


... I'm not entirely happy about the positioning method

I agree with your comment about the positioning of the UF. It behaves
a bit strange. For the initial position it is -Application.left * 2 +
the offset to to the right. Afterwards when you switch the parent with
your code the factor must be *1 and not *2. Maybe setwindowsPos is
easier and better to predict. I didn't dig into that one yet.

Better to use GetWindowRect, ie the new container for the form (see demo
below)

Overall I'm happy to see that it is possible with this special UF
setup to simulate a commandbar at the bottom of the main Excel 2007
window, despite MS efforts to make us all use the ribbon interface
instead of the commandbars.

<smile

The next challenge I'm interested in is to
"dock" such a userform on the left or the right side of the main Excel
window.

Interesting idea (difficult in Excel 2007 though), see below

Following is a demo to show the form in the Satusbar (all versions) OR in a
dummy commandbar docked to left/right or bottom (xl2000-3 only).
Start a new project a normal module and a userform (note the wb close event
in the ThisWorkbook module).
In the form add three small buttons, sized as suggested in the comments,
*after* adding the buttons add a Label

Add two Forms buttons to a sheet, assigned to macros as detailed in the
comments
In cell D11, enter SB, L, R or B (see GetFormSettings).
Run from the ShowForm button
do *not* edit code while the form and hook is running

Have fun !

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''
' Userform1
' put 3 fairly small buttons on the form, say wd/ht 30x18
' then a label, say wd/ht 18x18 with no caption
' StartUpPosition: 0 Manual
'

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 Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByRef lpRect As RECT) As Long

Private mRctXL2 As RECT

Private mhWndForm As Long
Private mhWndBar As Long
Private mhWndEXCEL2 As Long

Dim mbOnBar As Boolean

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 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
If gbUseEXCEL2 Then
hWndP = mhWndEXCEL2
Else
hWndP = mhWndBar
End If
Else
hWndP = Application.hwnd
End If

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

End Sub
Public Sub PosForm()
Dim d As Double
Dim rctBar As RECT
Dim Points2Pixels As Double

' If gbStatusBar Then
' d = -Application.Left + 60
' Else
' If gBarPos = msoBarRight Then
' d = -Application.Left - Application.Width + 21
' Else
' d = -Application.Left
' End If
' End If


Points2Pixels = 0.75 ' << normally should get this with APIs

Call GetWindowRect(mhWndBar, rctBar)
d = -rctBar.Left * Points2Pixels

If gbStatusBar Then
d = d + 60
End If

Me.Left = d
Me.Top = 0

End Sub

Private Sub CommandButton1_Click()
MsgBox CommandButton1.Caption
' Unload Me
End Sub

Private Sub CommandButton2_Click()
MsgBox CommandButton2.Caption
End Sub

Private Sub CommandButton3_Click()
MsgBox CommandButton3.Caption
End Sub

Public Sub UserForm_Activate()
PosForm
End Sub

Private Sub UserForm_Initialize()
Dim bFlag As Boolean
Dim bStatusBar As Boolean
Dim hWndEXCEL2 As Long
Dim sBarClass As String

If Val(Application.Version) = 10 Then
gHwndApp = Application.hwnd
Else
gHwndApp = FindWindow("XLMAIN", Application.Caption)
End If

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


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

mhWndBar = FindWindowEx(gHwndApp, 0&, sBarClass, vbNullString)

Else

' our dummy bar is contained in one of the EXCEL2 windows
mhWndEXCEL2 = FindWindowEx(gHwndApp, 0&, "EXCEL2", vbNullString)
Do
mhWndBar = FindWindowEx(mhWndEXCEL2, 0&, "MsoCommandBar", _
"DummyBar1")
If mhWndBar Then
Exit Do
Else
mhWndEXCEL2 = FindWindowEx(gHwndApp, mhWndEXCEL2, _
"EXCEL2", vbNullString)
End If
Loop Until mhWndEXCEL2 = 0

End If

If mhWndBar Then
RemoveTitleBar
AttachToBar True
Else
MsgBox "failed to find the bar window"
End If

End Sub

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

''' end Userform
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
' Normal module
' Put two Forms buttons on a sheet
' assign macros to ShowForm & CloseForm respectively
' Run from the ShowForm button

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

Public ghWndForm As Long ' Userform window
Public ghWndBar As Long ' Statusbar or commandbar window
Public gHwndApp As Long ' App window
Public gBarPos As MsoBarPosition ' location for docking
Public gbStatusBar As Boolean ' put form on statusbar or a docked
commandbar
Public gbUseEXCEL2 As Boolean ' experiment form on commandbar container
window

Private m_hHook As Long
Private mbIsMinimized As Boolean
Private mFrm As UserForm1


Sub CloseFrm()
UnhookCBT
If Not mFrm Is Nothing Then
On Error Resume Next
Unload mFrm
End If

dummyBar False
Set mFrm = Nothing
End Sub

Sub ShowForm()
Dim frmPos As Long, dPos As Double
Dim ctl As MSForms.Control

GetFormSettings

Application.DisplayStatusBar = True

gHwndApp = Application.hwnd ' need a different way in Excel 2000

If gbStatusBar = False Then
If Val(Application.Version) = 12 Then
MsgBox "Can't use Commandbars in Excel7+ !!"
Exit Sub
End If
dummyBar True
End If

Set mFrm = New UserForm1

' align controls horizontally or verticaly
For Each ctl In mFrm.Controls
If gBarPos = msoBarBottom Or gbStatusBar Then
ctl.Top = 0
ctl.Left = dPos
dPos = dPos + ctl.Width
Else
ctl.Left = 0
ctl.Top = dPos
dPos = dPos + ctl.Height
End If
Next

' ensure form is wide or tall enough
If gBarPos = msoBarBottom Or gbStatusBar Then
mFrm.Width = dPos
Else
mFrm.Height = dPos
End If

mFrm.Show vbModeless

HookCBT

End Sub

Private Function GetFormSettings() As Boolean
Dim s As String

' pick up settings from the sheet
' in D11 enter SB statusbar, or L R B docking

Range("C11") = "SB,L,R,B"
s = UCase(Range("D11"))
gbStatusBar = False

Select Case s
Case "SB": gbStatusBar = True
Case "L": gBarPos = msoBarLeft
Case "R": gBarPos = msoBarRight
Case "B": gBarPos = msoBarBottom
Case Else:
Range("D11") = "SB"
gbStatusBar = True
End Select

' ignore this, more work to do with form in the EXCEL2 window
Range("C12") = "use EXCEL2"
gbUseEXCEL2 = CBool(Val(Range("D12"))) ' enter 0 or 1 in D12

End Function

Public Sub dummyBar(bCreate As Boolean)
Dim i As Long, j As Long, cnt As Long
Dim cbr As CommandBar

' delete any old bars
On Error Resume Next
For i = 1 To 2
CommandBars("DummyBar" & i).Delete
Next
On Error GoTo 0

' adjust cnt to add enough buttons for a tad less
' than width or height of the form
If gBarPos = msoBarBottom Then
cnt = 5 ' << adjust
Else
cnt = 3 ' << adjust
End If

' create one or more dummy bars for the form
If bCreate Then
For i = 1 To 1 ' << adjust only if gbUseEXCEL2

Set cbr = CommandBars.Add("DummyBar" & i, gBarPos, , True)
cbr.Visible = True
For j = 1 To cnt
With cbr.Controls.Add
.Style = msoButtonIcon
End With
Next

Next
End If

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 ' some chagne to xlApp main window
If nCode = HCBT_MINMAX Then
' it's a min/max event
If WordLo(lParam) = SW_MINIMIZE Then
bIsMin = True
Else
' maybe max or normal
bIsMin = False
End If

If bIsMin < mbIsMinimized Then ' minimize status is changing
mbIsMinimized = bIsMin

mFrm.AttachToBar (Not mbIsMinimized)
If bIsMin Then
mFrm.Hide
Else
mFrm.Show vbModeless
End If
End If

ElseIf nCode = HCBT_MOVESIZE Then
'' it's a resize event
' mFrm.PosForm

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
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''

'''''''''''''''''''''''''''
'' ThisWorkbook module

Private Sub Workbook_BeforeClose(Cancel As Boolean)
CloseFrm
End Sub


Regards,
Peter T


All times are GMT +1. The time now is 12:31 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com