Hi aks

If you subscribe to the msnews.microsoft.com news server, you'll find that
all the microsoft.public groups are there, and messages remain on the server
for about 2 months before scrolling off.

Here is the original post:

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.