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
|