Msg Box
Morris Gray
Can anyone help?
I want to re-locate a Msg Box.
When the Msg Box appears it covers the Column that I need to see, containing
the info that the Msg Box is asking for.
How can I move the Msg Box to the LEFT.
Gracias and thanks.
Morris
Stratos Malasiotis
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
Alan Linton
Also see the Excel help for Activewindow.ScrollRow and
ActiveWindow.ScrollColumn
You can use these commands to move a cell you want to see to the top
left corner of the window. Here's a small code fragment from one of my
programs. It puts a cell 5 rows down from the top of the window so that
I can see it in context without it being hidden by a msgbox.
ActiveSheet.Cells(r, c).Select
If r > 5 Then ActiveWindow.ScrollRow = r - 5
mb = MsgBox("...
In article <399561F2...@csv.warwick.ac.uk>, Stratos Malasiotis
<ie...@csv.warwick.ac.uk> writes
>Hi Morris,
[snip]
>Stratos
>
>
>Morris Gray wrote:
>>
>> Hi.
>> Can anyone help?
>> I want to re-locate a Msg Box.
>> When the Msg Box appears it covers the Column that I need to see, containing
>> the info that the Msg Box is asking for.
>> How can I move the Msg Box to the LEFT.
>>
>> Gracias and thanks.
>> Morris
Hope this helps
--
Alan Linton