Not much movement in the newsgroup today :-)

I have re-writen Jim Rech's procedure in combination with K.Getz's
AddrOf for positioning a message box in Excel 97.

I still believe that it is a bad idea, but I though that it is good to
show hooking and sub-classing examples and is also  the AddrOf function
once so often.

Just to emphasise once again that all the intelligent part in this code
listing have **NOT** been done by me.

In a standard module add:
----------------------------------------------------------------------
Sub test1_fncMsgBox_Pos97()
  Dim aResult As Long
  aResult = fncMsgBox_Pos97(MsgBox_Prompt:="This a message generated
based on techniques designed by Jim Rech and Ken Getz", _
                          MsgBox_Buttons:=vbOKCancel + vbExclamation, _
                          MsgBox_Title:="Magic MsgBox", _
                          MsgBox_Top:=50, _
                          MsgBox_Left:=50)
  If aResult = vbOK Then
     fncMsgBox_Pos97 MsgBox_Prompt:="You hit the OK button"
  Else
     fncMsgBox_Pos97 MsgBox_Prompt:="You hit the Cancel button"
  End If

End Sub
---------------------------------------------------------------------  

 in another standard module add (exactly as it is and ensuring that no
line breaks have been inserted by the email):
-----------------------------------------------------------------------
Option Explicit

Declare Function GetCurrentThreadId _
        Lib "kernel32" () _
        As Long

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

Declare Function UnhookWindowsHookEx _
        Lib "user32" _
       ( _
        ByVal hHook As Long _
       ) _
        As Long

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

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

Declare Function GetCurrentVbaProject _
        Lib "vba332.dll" _
        Alias "EbGetExecutingProj" _
       ( _
        hProject As Long _
       ) _
        As Long

Declare Function GetFuncID _
        Lib "vba332.dll" _
        Alias "TipGetFunctionId" _
       ( _
        ByVal hProject As Long, _
        ByVal strFunctionName As String, _
        ByRef strFunctionID As String _
       ) _
        As Long

Declare Function GetAddr _
        Lib "vba332.dll" _
        Alias "TipGetLpfnOfFunctionId" _
       ( _
        ByVal hProject As Long, _
        ByVal strFunctionID As String, _
        ByRef lpfn As Long _
       ) _
        As Long

Dim TempHook As Long, _
    Callback_MsgBox_Top As Long, _
    Callback_MsgBox_Left As Long

Public Function fncMsgBox_Pos97 _
      ( _
       MsgBox_Prompt As String, _
       Optional MsgBox_Buttons As Long, _
       Optional MsgBox_Title As String = "Microsoft Excel", _
       Optional MsgBox_HelpFile As String, _
       Optional MsgBox_Context As Long, _
       Optional MsgBox_Top As Integer, _
       Optional MsgBox_Left As Integer _
      ) _
       As Variant
 '
 'declarations of Win32 API constants
  Const WH_CBT = 5, GWL_HINSTANCE = (-6)
 '
 'give the msgbox positioning dimensions a module-level scope _
  so that the callback function can use them
  Callback_MsgBox_Top = MsgBox_Top
  Callback_MsgBox_Left = MsgBox_Left
 '
 'set a Windows hook on the Excel's thread of current instance
  TempHook = SetWindowsHookEx _
            ( _
             idHook:=WH_CBT, _
             lpfn:=AddrOf("cbkPositionMsgBox"), _
             hmod:=GetWindowLong(0, GWL_HINSTANCE), _
             dwThreadId:=GetCurrentThreadId() _
            )
  '
  'compose and execute an Excel's message
   On Error Resume Next
   fncMsgBox_Pos97 = MsgBox(MsgBox_Prompt, _
                            MsgBox_Buttons, _
                            MsgBox_Title, _
                            MsgBox_HelpFile, _
                            MsgBox_Context _
                           )
  '
  'pass the result of the function to the calling procedure
  '
End Function

Function cbkPositionMsgBox _
        ( _
         ByVal lMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long _
        ) _
         As Long
 'Windows callback procedure for positioning the first new active window
 '
 'declarations of Win32 API constants
  Const HCBT_ACTIVATE = 5, _
        SWP_NOSIZE = &H1, SWP_NOZORDER = &H4, SWP_NOACTIVATE = &H10
 '
 'set an error handler so that no error can pass back to Excel
  On Error GoTo ExitCallback
 '
 'action only if Windows sends an HCBT_ACTIVATE message through _
  Excel's thread
  If lMsg = HCBT_ACTIVATE And _
     wParam <> FindWindow("XLMAIN", Application.Caption) Then
    'position the window specified by wParam; _
     don't affect any other of common MsgBox
     SetWindowPos _
                  hWnd:=wParam, _
                  hWndInsertAfter:=0, _
                  x:=Callback_MsgBox_Left, _
                  y:=Callback_MsgBox_Top, _
                  cx:=0, _
                  cy:=0, _
                  wFlags:=SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
     '
     'unhook the callback from Excel's thread so that it doesn't apply
to _
      subsequesnt actions and Excel can close normally
      UnhookWindowsHookEx TempHook
   End If
ExitCallback:
   cbkPositionMsgBox = 0
End Function

Function AddrOf _
        ( _
         CallbackFunctionName As String _
        ) _
         As Long
 '
    Dim aResult As Long
    Dim CurrentVBProject As Long
    Dim strFunctionID As String
    Dim AddressofFunction As Long
    Dim UniCbkFunctionName As String
 '
 'convert the name of the function to Unicode system
  UniCbkFunctionName = StrConv(CallbackFunctionName, vbUnicode)
 '
 'if the current VBProjects exists  ...
    If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
      '... get the function ID  of the callback function based on its
name, _
           in order to ensure that the function exists
       aResult = GetFuncID _
                            ( _
                              hProject:=CurrentVBProject, _
                              strFunctionName:=UniCbkFunctionName, _
                              strFunctionID:=strFunctionID _
                            )
      'if the function exists  ...
       If aResult = 0 Then
         '...get a pointer to the callback function based on
strFunctionID
          aResult = GetAddr _
                           ( _
                            CurrentVBProject, _
                            strFunctionID, _
                            lpfn:=AddressofFunction _
                          )
         'if we have got the pointer pass it to the result of the
function
          If aResult = 0 Then
             AddrOf = AddressofFunction
          End If
        End If
    End If
End Function
--------------------------------------------------------------------------- ---

Swich to Excel and run test1_fncMsgBox_Pos97() from the Macros Dialog or
assign a macro to shape. This should work directly although I can't be
sure of how AddrOf will bahave (it usually works with me).
I haeve made a small modification that allows Jim's callback to work
from the VBE as well (it positions Excel before since that was the first
activated window) but it not the proper way in my opinion.
I haven't checked the function using Help files but I guess there should
not be a problem there.

HTH
Stratos