From time to time I see people say "don't even try." Yet the KB below
baits you in VB5+...
http://support.microsoft.com/default...;EN-US;q180936

I have tried to implement in XL2000 VBA without success. Should I stop
even bothering (or make my own form)? The standard msgbox positioning
combined with the scroll positioning (e.g. from a Find) is irritatingly
adept at obscuring the active cell. In 99% of the cases, if the msgbox
was in the upper right corner of screen, I could just hit Y,N,Esc, or
whatever without even looking inside it...and there's no obscuring then.

This seems to do what you want. Run ShowMsgBoxInXLTopRight.

--
Jim Rech
Excel MVP

'---------------------

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

Public Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook 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 GetCurrentThreadId Lib "kernel32" () As Long
Public 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
Public 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 GetWindowRect Lib "user32" (ByVal hwnd _
As Long, lpRect As RECT) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Public Const GWL_HINSTANCE = (-6)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public hHook As Long
Public hXL As Long

Sub ShowMsgBoxInXLTopRight()
Dim hInst As Long
Dim Thread As Long
hXL = FindWindow("XLMAIN", Application.Caption)
hInst = GetWindowLong(hXL, GWL_HINSTANCE)
Thread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, hInst, Thread)
MsgBox "This message box has been positioned to the top right of Excel's
window."
End Sub

Function WinProc(ByVal lMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim rectXL As RECT, rectMsg As RECT
Dim x As Long, y As Long
Dim hMsgbox As Long

If lMsg = HCBT_ACTIVATE Then
hMsgbox = GetActiveWindow
GetWindowRect hXL, rectXL
GetWindowRect wParam, rectMsg
x = (rectXL.Left + (rectXL.Right - rectXL.Left) * 0.75) - _
((rectMsg.Right - rectMsg.Left) / 2)
y = (rectXL.Top + (rectXL.Bottom - rectXL.Top) * 0.3) - _
((rectMsg.Bottom - rectMsg.Top) / 2)
SetWindowPos wParam, 0, x, y, 0, 0, _
SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
UnhookWindowsHookEx hHook
End If
WinProc = False
End Function

Thank you kindly. It won't compile in XL97 but I'll try others later.

On Wed, 27 Aug 2003 10:56:34 -0400, "Jim Rech"
wrote:

This seems to do what you want. Run ShowMsgBoxInXLTopRight.

xl97 doesn't support "AddressOf"


Here is a past posting that should work in xl97:

http://groups.google.com/groups?selm... output=gplain

Position a Message box by Stratos:

From: Stratos Malasiotis
Subject: Msg Box
Date: 2000/08/12
Message-ID:
Content-Transfer-Encoding: 7bit
References:
To: Morris Gray
X-Accept-Language: en
Content-Type: text/plain; charset=us-ascii
X-Complaints-To:
X-Trace: wisteria.csv.warwick.ac.uk 966091252 9682 137.205.42.204 (12 Aug
2000 14:40:52 GMT)
Organization: University of Warwick, UK
Mime-Version: 1.0
NNTP-Posting-Date: 12 Aug 2000 14:40:52 GMT
Newsgroups: microsoft.public.excel.programming


Hi Morris,

Last week someone asked the same question to whome I replied with the
following function.
It was originally designed by Jim Rech; I just convert his technique to a
function , nothing more.

It is designed for XL97 ; if it doesn't work in 2000 (it should) you'll have
to replace K.Getz's AddrOf function with the build in AddessOf
function.

In a standard module add:
-------------------------------------------------------
Sub test1_fncMsgBox_Pos97()
Dim aResult As Long
aResult = fncMsgBox_Pos97(MsgBox_Prompt:="This a message box with a touch of
magic", _
MsgBox_Buttons:=vbOKCancel + vbExclamation, _
MsgBox_Title:="Magic MsgBox", _
MsgBox_Top:=50, _
MsgBox_Left:=500)
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
--------------------------------------------------

and in another:
----------------------------------------------------
Option Explicit

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

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
'wraps the common Excel's MsgBox function with a callback function that
'positions the msgbox window after it is created
'
'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 activated 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 and the activated window is not Excel itself
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 attributes
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, CurrentVBProject As Long, strFunctionID As String,
_
AddressofFunction As Long, 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

----------------------------------------------------------------------------
------------

HTH
Stratos

========================================

--
Regards,
Tom Ogilvy


"Wild Bill" wrote in message
...
Thank you kindly. It won't compile in XL97 but I'll try others later.

On Wed, 27 Aug 2003 10:56:34 -0400, "Jim Rech"
wrote:

This seems to do what you want. Run ShowMsgBoxInXLTopRight.

That's it. [Y.A.] Way to go, Tom.

On Thu, 28 Aug 2003 08:18:59 -0400, "Tom Ogilvy"
wrote:

xl97 doesn't support "AddressOf"


Here is a past posting that should work in xl97:

http://groups.google.com/groups?selm... output=gplain