Docked forms in Word - solution

[Alex]

Gather 'round, boys and girls, there's a treat for you tonight.

I needed to dock a form in Word but couldn't find a solution. Google showed several failed attempts.
So I sat down and beat some code into submission.

There are some caveats:

1. The form only docks to a specific edge right now (right edge).
The reason is that a toolbar changes its X/Y dimensions when docked to horizontal/vertical edges and I didn't find a way to deal with that.
Suggestions are more than welcome.

2. I am really not a VBA guru. If you find a way to clean or streamline this code, please post.

Here's the beef:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Public Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

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

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

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

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

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

Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Public Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

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

Public Const GWL_STYLE As Long = (-16)
Public Const WS_DLGFRAME As Long = &H400000
Public Const WS_VISIBLE As Long = &H10000000
Public Const WS_CHILD As Long = &H40000000

Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private cb As CommandBar
Private ctl As CommandBarControl
Private BarHandle As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim length As Long
Dim text As String

EnumChildProc = 1
text = String$(256, 0)
length = GetClassName(hwnd, text, 256)
If (length <> 0) And (Left$(text, length) = "MsoCommandBar") Then
length = GetWindowText(hwnd, text, 256)
If (length <> 0) And (Left$(text, length) = "Docker") Then
BarHandle = hwnd
EnumChildProc = 0
End If
End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub DockForm()
Set ctl = CommandBars.FindControl(Tag:="Filler")
If ctl Is Nothing Then
Set cb = CommandBars.Add(Name:="Docker", Position:=msoBarRight, Temporary:=True)
Set ctl = cb.Controls.Add(Type:=msoControlButton, Temporary:=True)
With cb
.Visible = True
.Enabled = True
.Protection = msoBarNoCustomize Or msoBarNoResize & msoBarNoMove
End With
With ctl
.Tag = "Filler"
.Enabled = False
.Visible = True
End With
Else
Set cb = CommandBars("Docker")
End If

MyForm.Show vbModeless
Dim FormHandle As Long
FormHandle = FindWindow("ThunderDFrame", MyForm.Caption)

Dim AppHandle As Long
AppHandle = FindWindow("OpusApp", _
ActiveWindow.Caption & " - " & Application.Caption)
If AppHandle = 0 Then
AppHandle = FindWindow("OpusApp", vbNullString)
End If

EnumChildWindows AppHandle, AddressOf EnumChildProc, 0&

Dim height As Long
height = Application.PointsToPixels(MyForm.InsideWidth, True)

SetWindowLong FormHandle, GWL_STYLE, WS_CHILD Or WS_VISIBLE Or WS_DLGFRAME
SetParent FormHandle, BarHandle
SetWindowPos FormHandle, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED

ctl.height = height
ctl.Width = Application.PointsToPixels(MyForm.InsideHeight, True)

Dim rct As RECT
GetWindowRect BarHandle, rct
SetWindowPos FormHandle, 0, 0, Application.PixelsToPoints(rct.Bottom - rct.Top - height), _
0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Cleanup()
MyForm.Hide
If Not ctl Is Nothing Then
ctl.Delete Temporary:=False
End If
If Not cb Is Nothing Then
cb.Delete
End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Best wishes,
Alex.

[Nick Hebb]

Alex, this is great. You've saved me a ton of research because I was
going to attempt this in my add-in. Thanks.

[Alex]

Hello Nick,

Post by Nick Hebb
Alex, this is great. You've saved me a ton of research because I was
going to attempt this in my add-in. Thanks.

I am glad that helped.

Please share any insights that you may have from working with this code.
I know it is not perfect...


Best wishes,
Alex.

[Nick Hebb]

Alex,

I'll do that, but it will probably be in a month or two. I'm working
on an Excel project right now before I get to the Word project wherein
I'd use it.

The only immediate feedback I have is the line:
Set ctl = CommandBars.FindControl(Tag:="Filler")

I would write:
On Error Resume Next
Set ctl = CommandBars.FindControl(Tag:="Filler")
On Error Goto 0

This prevents an error being raised if the ctl does exist.

The one line that confuses me is the one that contains:
msoBarNoCustomize Or msoBarNoResize & msoBarNoMove

When I do a Debug.Print of the enumerated constants I get the following
msoBarNoCustomize = 1 (0000 0001 in binary)
msoBarNoResize = 2 (0000 0010 in binary)
msoBarNoMove = 4 (0000 0100 in binary)

So, msoBarNoCustomize Or msoBarNoResize = 3 (0000 0011 in binary). But
when you use the "&" symbol, that's a concatenation (And is the VB
binary operator).

The result of msoBarNoCustomize Or msoBarNoResize & msoBarNoMove = 25,
which is 0001 1001 in binary. I don't get how the concatenation
operator works in this regard and whether that's what you intended. If
you want all 3 properties I would think the & should be replaced by an
Or.

--Nick

[Alex]

Hello Nick,

Post by Nick Hebb
On Error Resume Next
Set ctl = CommandBars.FindControl(Tag:="Filler")
On Error Goto 0

This was only a proof of concept.
My working code will be in C#.

Post by Nick Hebb
msoBarNoCustomize Or msoBarNoResize & msoBarNoMove

A typo. Should have been:
msoBarNoCustomize Or msoBarNoResize Or msoBarNoMove

[Cindy M -WordMVP-]

Hi Alex

This is really great, thanks so much for sharing it with us
:-) I'm marking it as a "keeper", for the next time someone
asks.

I looked at the VBA, but there's really very little of that
in there; mostly calls to the Windows API.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update
Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any
follow question or reply in the newsgroup and not by e-mail
:-)

[Alex]

Hello Cindy,

Post by Cindy M -WordMVP-
Hi Alex
This is really great, thanks so much for sharing it with us
:-) I'm marking it as a "keeper", for the next time someone
asks.

Thanks for your kind words.

Post by Cindy M -WordMVP-
I looked at the VBA, but there's really very little of that
in there; mostly calls to the Windows API.

There were some pointers from Nick so if you point somebody this way, make sure they read the whole thread.

There is one unsolved problem: undocking & redocking.
Hope that somebody will pitch in...

[Jonathan West]

Hi Alex,

I definitely intend taking a detailed look at this, and will report back any
findings I have. A docked userform is something I have been wanting for a
good long time now!
--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org

"Alex" <***@online.nospam> wrote in message news:%***@TK2MSFTNGP10.phx.gbl...
Gather 'round, boys and girls, there's a treat for you tonight.

I needed to dock a form in Word but couldn't find a solution. Google showed
several failed attempts.
So I sat down and beat some code into submission.

There are some caveats:

1. The form only docks to a specific edge right now (right edge).
The reason is that a toolbar changes its X/Y dimensions when docked to
horizontal/vertical edges and I didn't find a way to deal with that.
Suggestions are more than welcome.

2. I am really not a VBA guru. If you find a way to clean or streamline
this code, please post.

Here's the beef:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Public Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

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

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

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As
Long) As Long

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

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

Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As
Long

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As
Long) As Long

Public Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

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

Public Const GWL_STYLE As Long = (-16)
Public Const WS_DLGFRAME As Long = &H400000
Public Const WS_VISIBLE As Long = &H10000000
Public Const WS_CHILD As Long = &H40000000

Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20 ' The frame changed: send
WM_NCCALCSIZE
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private cb As CommandBar
Private ctl As CommandBarControl
Private BarHandle As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim length As Long
Dim text As String

EnumChildProc = 1
text = String$(256, 0)
length = GetClassName(hwnd, text, 256)
If (length <> 0) And (Left$(text, length) = "MsoCommandBar") Then
length = GetWindowText(hwnd, text, 256)
If (length <> 0) And (Left$(text, length) = "Docker") Then
BarHandle = hwnd
EnumChildProc = 0
End If
End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub DockForm()
Set ctl = CommandBars.FindControl(Tag:="Filler")
If ctl Is Nothing Then
Set cb = CommandBars.Add(Name:="Docker", Position:=msoBarRight,
Temporary:=True)
Set ctl = cb.Controls.Add(Type:=msoControlButton, Temporary:=True)
With cb
.Visible = True
.Enabled = True
.Protection = msoBarNoCustomize Or msoBarNoResize & msoBarNoMove
End With
With ctl
.Tag = "Filler"
.Enabled = False
.Visible = True
End With
Else
Set cb = CommandBars("Docker")
End If

MyForm.Show vbModeless
Dim FormHandle As Long
FormHandle = FindWindow("ThunderDFrame", MyForm.Caption)

Dim AppHandle As Long
AppHandle = FindWindow("OpusApp", _
ActiveWindow.Caption & " - " &
Application.Caption)
If AppHandle = 0 Then
AppHandle = FindWindow("OpusApp", vbNullString)
End If

EnumChildWindows AppHandle, AddressOf EnumChildProc, 0&

Dim height As Long
height = Application.PointsToPixels(MyForm.InsideWidth, True)

SetWindowLong FormHandle, GWL_STYLE, WS_CHILD Or WS_VISIBLE Or
WS_DLGFRAME
SetParent FormHandle, BarHandle
SetWindowPos FormHandle, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or
SWP_FRAMECHANGED

ctl.height = height
ctl.Width = Application.PointsToPixels(MyForm.InsideHeight, True)

Dim rct As RECT
GetWindowRect BarHandle, rct
SetWindowPos FormHandle, 0, 0, Application.PixelsToPoints(rct.Bottom -
rct.Top - height), _
0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Cleanup()
MyForm.Hide
If Not ctl Is Nothing Then
ctl.Delete Temporary:=False
End If
If Not cb Is Nothing Then
cb.Delete
End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Best wishes,
Alex.