"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