Go Back  Xtreme Visual Basic Talk > Legacy Visual Basic (VB 4/5/6) > VBA / Office Integration > Excel > How do I manipulate the position msgbox?


Reply
 
Thread Tools Display Modes
  #1  
Old 10-08-2003, 06:30 PM
tboltfrank tboltfrank is offline
Senior Contributor
 
Join Date: Jul 2003
Posts: 1,022
Default How do I manipulate the position of a msgbox?


How can I position this msgbox? - The top left of the Excel App. is where I would like to put it, but in help, I only see positioning for an input box, not a MsgBox.
Thanks in advance for help with this...
Code:
Sub YesNoMsgBox() Dim Msg, Style, Response Style = vbYesNo + vbExclamation Msg = "MsgBox Test" Response = MsgBox(Msg, Style) If Response = vbNo Then Exit Sub End If If Response = vbYes Then ' run code End If End Sub

Last edited by tboltfrank; 10-08-2003 at 06:37 PM.
Reply With Quote
  #2  
Old 10-08-2003, 06:58 PM
italkid's Avatar
italkid italkid is offline
Down...

Retired Moderator
* Expert *
 
Join Date: Dec 2002
Location: Belgium.
Posts: 6,731
Default

Not possible as far as i know > should do it with a userform then...
Reply With Quote
  #3  
Old 10-08-2003, 07:13 PM
Rekd's Avatar
Rekd Rekd is offline
Junior Contributor
 
Join Date: Jun 2003
Location: Un-bound array
Posts: 255
Default

Quote:
Not possible as far as i know > should do it with a userform then...
Correct. Even with API I don't think it's possible. But it IS possible to make a form look just like a message box.

'Rekd
__________________
Chasing your kid around the house yelling “TickleMonster! Gonna get you!” is fun.
Chasing a stranger around the mall yelling “TickleMonster! Gonna get you!” is apparently a misdemeanor.
Reply With Quote
  #4  
Old 10-08-2003, 07:26 PM
Legend Legend is offline
Contributor
 
Join Date: Dec 2002
Posts: 542
Default

Quote:
Originally Posted by Rekd
Correct. Even with API I don't think it's possible. But it IS possible to make a form look just like a message box.

'Rekd



Ahh! Ye have little faith!

Code:
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 Declare Function FindWindow _ Lib "user32" _ Alias "FindWindowA" _ ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String _ ) _ 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 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:=180, _ 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

I can't give credit where it is due, 'cause I can't remember where I got this code. Originally from BlackBelt? VBPJ? Dunno.... It appears that Jim Rech & Ken Getz had something to do with it. It appears to use undocumented functions and callbacks. More hassle than its worth, but it is doable!
Reply With Quote
  #5  
Old 10-08-2003, 07:29 PM
Legend Legend is offline
Contributor
 
Join Date: Dec 2002
Posts: 542
Default

P.S. - this code is for Excel 97 only. Anyone wanna have a go at fixing it to excel 2000? :lol:
Reply With Quote
  #6  
Old 10-08-2003, 08:24 PM
tboltfrank tboltfrank is offline
Senior Contributor
 
Join Date: Jul 2003
Posts: 1,022
Default

Thanks Legend and everyone.

Yeah, that is a bit much... But it's nice to (once again) see that most things can be done, if it has to be

I think I'll just use an InputBox as my MsgBox, as I need this to be a copy paste routine. - I'll think of some optional use for input, so it won't seem out of place
Reply With Quote
  #7  
Old 10-08-2003, 08:59 PM
Rekd's Avatar
Rekd Rekd is offline
Junior Contributor
 
Join Date: Jun 2003
Location: Un-bound array
Posts: 255
Default

Quote:
Ahh! Ye have little faith!
I should've known to hold my tounge for a few minutes.. I'mma stash that snippit away in my favorites folder..

'Rekd
__________________
Chasing your kid around the house yelling “TickleMonster! Gonna get you!” is fun.
Chasing a stranger around the mall yelling “TickleMonster! Gonna get you!” is apparently a misdemeanor.
Reply With Quote
  #8  
Old 10-08-2003, 09:24 PM
Mike Rosenblum's Avatar
Mike Rosenblum Mike Rosenblum is offline
Microsoft Excel MVP

Forum Leader
* Guru *
 
Join Date: Jul 2003
Location: New York, NY, USA
Posts: 7,848
Default

Heh, and just yesterday, Lebb was tryning to convince me that API's are easy! Ha!

No, I'll stay safely behind my VBA blanket... thanks though for the demo!

-- Mike
Reply With Quote
  #9  
Old 10-08-2003, 10:34 PM
Legend Legend is offline
Contributor
 
Join Date: Dec 2002
Posts: 542
Default

Quote:
Originally Posted by Mike_R
Heh, and just yesterday, Lebb was tryning to convince me that API's are easy! Ha!

No, I'll stay safely behind my VBA blanket... thanks though for the demo!

-- Mike


APIs are easy. Its the undocumented functions and callbacks that are a bit trickier
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Change MsgBox position masnick-CCCP General 2 10-04-2003 09:51 AM
Need this code reviewed... is this the correct forum? Jatopian Game Programming 4 09-27-2003 09:56 AM
How can I check for duplicates before saving a new record GOTzMADsKILLz Database and Reporting 19 08-15-2002 12:56 PM
Timers jemerico General 7 05-30-2001 06:30 PM

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
 
 
-->