Code to close MsgBox?
Ctrl-Alt-Dlt-Hlp
click on it?
Excel97 SR2 Windows95
TIA
--
Ctrl-Alt-Dlt-Hlp ô)ô
Sent via Deja.com http://www.deja.com/
Before you buy.
Chip Pearson
No. When a message box (or an input box) is displayed, all VBA code execute
is suspended. If you need to automatically close a message box after some
period of time, use a UserForm instead, and then use an OnTime procedure to
hide the form.
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com ch...@cpearson.com
"Ctrl-Alt-Dlt-Hlp" <wils...@my-deja.com> wrote in message
news:8qaldq$rqg$1...@nnrp1.deja.com...
Ctrl-Alt-Dlt-Hlp
answer. I shy away from user forms because I get strange error
messages whenever I try to use them. I guess I'll have to give it a go
and ask this great ng about the error messages when they arise.
Best Regards,
In article <OxruBmxIAHA.270@cppssbbsa04>,
Jim Rech
I believe it's part of Windows 98 among other things, you can run this:
Sub SelfClosingMsgBox()
CreateObject("WScript.Shell").Popup "Hello", 2, "This closes itself in 2
seconds"
End Sub
--
Jim Rech
Excel MVP
Stratos Malasiotis
>I shy away from user forms because I get strange error
>messages whenever I try to use them.
Come on, ... <g>. I have seen you doing really nice things . No need to shy away from it.:-)
And at the end of the day what do you prefer: To get a few vba errors or some GPFs by developing functions like the following.
It may be creating a self-closing messagebox but does it worth the effort?
HTH
Stratos
to tested run the:
Sub test()
fncSelfClosingMsgBox MsgBox_Prompt:="test", MsgBox_TimeOut:=1000
End Sub
sub procedure where 1000 is one second (in milliseconds)
(in astandard module)
-------------------------
Option Explicit
Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long
Public Declare Function DestroyWindow _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long
Declare Function SetTimer _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long _
) _
As Long
Declare Function KillTimer _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long _
) _
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
Private Declare Function GetCurrentVbaProject _
Lib "vba332.dll" _
Alias "EbGetExecutingProj" _
( _
hProject As Long _
) _
As Long
Private Declare Function GetFuncID _
Lib "vba332.dll" _
Alias "TipGetFunctionId" _
( _
ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionID As String _
) _
As Long
Private Declare Function GetAddr _
Lib "vba332.dll" _
Alias "TipGetLpfnOfFunctionId" _
( _
ByVal hProject As Long, _
ByVal strFunctionID As String, _
ByRef lpfnAddressOf As Long _
) _
As Long
Private TempHook As Long
Private MsgBoxTimeOut As Long
Private MsgBox_hWnd As Long
Private WindowsTimer As Long
Sub test()
fncSelfClosingMsgBox MsgBox_Prompt:="test", MsgBox_TimeOut:=1000
End Sub
Public Function fncSelfClosingMsgBox _
( _
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_TimeOut As Long = 0 _
) As Variant
Const WH_CBT = 5, GWL_HINSTANCE = (-6)
MsgBoxTimeOut = MsgBox_TimeOut
TempHook = SetWindowsHookEx _
( _
idHook:=WH_CBT, _
lpfn:=AddressOfCallback, _
hmod:=GetWindowLong(0, GWL_HINSTANCE), _
dwThreadId:=GetCurrentThreadId() _
)
On Error Resume Next
fncSelfClosingMsgBox = MsgBox( _
MsgBox_Prompt, _
MsgBox_Buttons, _
MsgBox_Title, _
MsgBox_HelpFile, _
MsgBox_Context _
)
End Function
Private Function cbkCloseMsgBox _
( _
ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) _
As Long
Const HCBT_ACTIVATE = 5
On Error GoTo ExitCallback
If lMsg = HCBT_ACTIVATE And _
wParam <> FindWindow("XLMAIN", Application.Caption) Then
MsgBox_hWnd = wParam
If Not MsgBoxTimeOut = 0 Then
WindowsTimer = SetTimer _
( _
hwnd:=MsgBox_hWnd, _
nIDEvent:=0, _
uElapse:=MsgBoxTimeOut, _
lpTimerFunc:=AddrOfcbkCustomTimer _
)
End If
UnhookWindowsHookEx TempHook
End If
ExitCallback:
cbkCloseMsgBox = 0
End Function
Private Function cbkCustomTimer _
( _
ByVal Window_hWnd As Long, _
ByVal WindowsMessage As Long, _
ByVal EventID As Long, _
ByVal SystemTime As Long _
) _
As Long
On Error Resume Next
Application.SendKeys ("%{F4}")
End Function
Private Function AddressOfCallback() As Long
If Val(Application.Version) > 8 Then
AddressOfCallback = AddressOf_Callback
Else 'use K.Getz & M.Kaplan function to get a pointer
AddressOfCallback = AddrOf("cbkCloseMsgBox")
End If
End Function
Private Function AddrOfcbkCustomTimer() As Long
If Val(Application.Version) > 8 Then
AddrOfcbkCustomTimer = AddrOf_cbkCustomTimer
Else 'use K.Getz & M.Kaplan function to get a pointer
AddrOfcbkCustomTimer = AddrOf("cbkCustomTimer")
End If
End Function
Private Function AddrOf _
( _
CallbackFunctionName As String _
) _
As Long
'AddressOf operator replacement for Office97 VBA
'Authors: Ken Getz and Michael Kaplan
'
'declaration of local variables
Dim aResult As Long
Dim CurrentVBProject As Long
Dim strFunctionID As String
Dim AddressOfFunction As Long
Dim UnicodeFunctionName As String
'
'convert the name of the function to Unicode system
UnicodeFunctionName = 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
'unicode-converted name, in order to ensure that it exists
aResult = GetFuncID _
( _
hProject:=CurrentVBProject, _
strFunctionName:=UnicodeFunctionName, _
strFunctionID:=strFunctionID _
)
'if the function exists indeed ...
If aResult = 0 Then
'...get a pointer to the callback function based on
'the strFunctionID argument of the GetFuncID function
aResult = GetAddr _
( _
hProject:=CurrentVBProject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFunction _
)
'if we've 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
Private Function AddressOf_Callback() As Long
'Office97 VBE does not recognise the AddressOf operator;
'however, it does not raise a compile-error either...
AddressOf_Callback = vbaPass(AddressOf cbkCloseMsgBox)
End Function
Private Function AddrOf_cbkCustomTimer() As Long
'Office97 VBE does not recognise the AddressOf operator;
'however, it does not raise a compile-error either...
AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
End Function
Private Function vbaPass(AddressOfFunction As Long) As Long
vbaPass = AddressOfFunction
End Function
-----------------------------------------------------------
Ctrl-Alt-Dlt-Hlp
Jim Rech for President! Thanks a bunch.
In article <#P$YmoyIAHA.283@cppssbbsa05>,
--
Chip Pearson
Well, well. That is quite nice. I didn't know about that one. I hope I
don't forget about it the next time I need something like this.
For reference, WSH comes with any of the following products (and probably a
few others): Windows98, Windows2000, Office2000, VS6, and IE5. So if you
have any one or more of these, you should have WSH.
You can also download the libraries and controls directly from MS at
http://www.microsoft.com/msdownload/vbscript/scripting.asp
Thanks, Jim.
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com ch...@cpearson.com
"Jim Rech" <jar...@kpmg.com> wrote in message
news:#P$YmoyIAHA.283@cppssbbsa05...
Alan B. Pearce
>few others): Windows98, Windows2000, Office2000, VS6, and IE5. So if you
>have any one or more of these, you should have WSH.
Isn't this one of the security backdoors that let virus's in on emails?
Tom Ogilvy
Not if you have your security settings and other configuration options set
up to prevent it. Plus MS has released a security patch to thwart this.
(However, many people don't like the patch because it is not configurable
and some would say throws the baby out with the bathwater in some
instances).
If you double click on an executable file attachment (vbscript) without the
proper settings, then this would probably be more like the security front
door. <g>
Regards,
Tom Ogilvy
MVP Excel
Alan B. Pearce <A.B.P...@rl.ac.uk> wrote in message
news:8qckrp$16...@newton.cc.rl.ac.uk...
Merk
start-up folder you don't even know what hit ya!!!
See KAKWORM virus
-Merk
Tom Ogilvy <twog...@msn.com> wrote in message
news:u2Ozhi8IAHA.297@cppssbbsa05...
Ctrl-Alt-Dlt-Hlp
but I get repeated error messages when I save and close the files.
Everything remains intact and functional, but I get error messages
saying the opposite. Plus Jim's solution is WAY COOL, don't you think
<g>
Best Regards,
In article <39C8F9A5...@csv.warwick.ac.uk>,
Stratos Malasiotis
Regards,
Stratos