Gestion d'évenements

Bonjour,

A tout hasard, et si c'est bien ce que vous demandez,
testez le code ci-dessous.

'********************
Sub Proc1()
Call Proc2
MsgBox "Proc1 est terminé"
End Sub

Private Sub Proc2() 'Private pour ne pas apparaître dans "Exécuter une macro"
MsgBox "Proc2 est terminé"
End Sub
'********************

Cordialement.

PMO
Patrick Morange

Bonjour et merci de vous être penché sur le pb.
Mais, je me rends compte que je me suis mal exprimé. Je vais tâcher
d'être plus explicite.

Il m'est demandé d'exécuter une procédure Proc2 appartenant au
classeur Wbk2.

Cette procédure fait appel à un MsgBox.

'--------------------
'A mettre dans le classeur Wbk2
Sub Proc2()

'Ensemble des instructions, et puis..
MsgBox "erreur"

End Sub
'--------------------


Maintenant, comment, à partir d'un autre classeur Wbk1 qui fait appel
à Proc2 de Wbk2, puis-je << passer au-dessus >> du MsgBox ?

Notamment puis-je demander de ne pas tenir compte des MsgBox ?
Ou peut-on lui dire de simuler le click sur le MsgBox ?

Merci d'avance pour votre aide.


DiaRep

Bonjour,

Me revoilà avec, ce coup ci, une meilleure compréhension de votre problème.

Je vous propose le code ci-dessous qui fait appel aux API et qui doit répondre
à votre attente.
Voilà ce que j'ai fait pour le tester :
1) création d'un classeur nommé "zaza"
2) dans "zaza" création d'une Sub "proc2" avec un pseudo traitement et
une MsgBox, DONT LE TITRE N'A PAS ETE SPECIFIE, et qui, par défaut,
affiche "Microsoft Excel".
3) dans un autre classeur, j'ai mis le code qui vous est proposé et qui
comporte
une Sub "proc1". Celle-ci appelle la "proc2" de "zaza.xls" et grâce aux
API
referme la MsgBox qu'elle contient.
Cela fonctionne très bien chez moi.
A vous de faire le même test avant tout, puis, si vous en êtes satisfait,
incluez
le code dans votre programme après l'avoir adapter.

A NOTER
Vérifiez le titre de la MsgBox indésirable et modifiez la Constante
TITRE_MSGBOX en conséquence.
Le délai "Call RunTimer(Delai:=0)" est réglé à 0 milliseconde. Pour le
modifier,
faites Call RunTimer(Delai:00) pour obtenir un délai d'1 seconde.


'************************
Option Explicit
'### Adapter la constante selon le Titre de la MsgBox ###
Private Const TITRE_MSGBOX As String = "Microsoft Excel"

Dim OnTimer&

Private Declare Function SendMessage& Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)

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

Private Declare Function SetTimer& Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)

Private Declare Function KillTimer& Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long)

Private Declare Function GetWindowText& Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long)
'___________________________
Private Sub CloseMsgBox()
Dim HwndMsgBox&
HwndMsgBox& = FindWindow(vbNullString, TITRE_MSGBOX)
Dim Ch$
Dim Tampon&
Dim reponse&
Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)
Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
If Ch$ = TITRE_MSGBOX Then
SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
End If
End Sub
'___________________________
Private Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf CloseMsgBox)
End Sub
'___________________________
Private Sub OffTimer()
If OnTimer& > 0 Then
OnTimer& = KillTimer(0&, OnTimer&)
OnTimer& = 0
End If
End Sub
'___________________________
Sub proc1()

'*** Code traitement avant appel à proc2 ***

'///// à ajouter à votre code ////
OnTimer& = 0
Call RunTimer(Delai:=0)
'---- Ici l'appel de proc2 (à adapter)----
Application.Run "zaza.xls!proc2"
'-----------------------------------------
Call OffTimer
'/////////////////////////////////

'*** Code traitement après appel à proc2 ***

MsgBox "C'est la proc1"
End Sub
'************************

A vous lire.
Cordialement.


PMO
Patrick Morange

En ce début d'année, c'est une heureuse surprise.
Cette réponse répond tout à fait à mon problème.

Et j'avoue que mon niveau en VBA ne m'aurait pas permis de mettre au
point une telle solution (et ne me permet pas encore de la comprendre)

J'espère que cette procédure permettra à d'autres de s'affranchir d'un
"Msgbox" gênant, connu par avance.

Merci beaucoup pour votre aide.
Bonne année 2008 !

DiaRep

Je me permets une dernière question.

En reprenant vos procédures, est-il possible de supprimer 2 Msgbox
dont les titres sont différents (TITRE_MSGBOX1 et TITRE_MSGBOX2) ?

J'ai notamment essayé les procédures suivantes :

'-----------------------
'1ère solution
Private Sub CloseMsgBox()

Dim HwndMsgBox&
HwndMsgBox& = FindWindow(vbNullString, TITRE_MSGBOX1)
Dim Ch$
Dim Tampon&
Dim reponse&
Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)
Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
If Ch$ = TITRE_MSGBOX1 Then
SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
End If



HwndMsgBox& = FindWindow(vbNullString, TITRE_MSGBOX2)
Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)

'Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
ThisWorkbook.Sheets("Feuil1").Cells(1, 1) = Ch
If Ch$ = TITRE_MSGBOX2 Then
SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
End If

end sub

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

'2e solution

Private Sub CloseMsgBox()

Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)
Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
Select Case Ch&
Case TITRE_MSGBOX1
SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
Case TITRE_MSGBOX2
SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
End Select

end sub
'-----------------------



Dans les deux cas, un seul des 2 MsgBox est "capturé". L'autre
apparaît à l'écran.

J'ai aussi tenté de remplacer TITRE_MSGBOX1 ou TITRE_MSGBOX2 par Null.
Mais dans ce cas-là, l'ensemble des classeurs Excel est intégralement
fermé dès l'apparition du premier MSgBox.


Merci d'avance,

DiaRep

Bonjour,

Voici une nouvelle version du code qui permet de fermer plusieurs
MsgBox indésirables dont les titres peuvent, éventuellement, être différents.

On adopte maintenant une variable Variant (MesTitres) en lieu et place
de la Constante (TITRE_MSGBOX). Ce Variant sera utilisé comme tableau
et pourra contenir de 1 à plusieurs titres. Il faudra adapter à votre usage :
MesTitres = Array("BILOU", "Microsoft Excel", "toto")

POUR TESTER
1) création d'un classeur nommé "zaza" et y inclure le code ci-dessous
'*******************
Sub proc2()
MsgBox "c'est la proc2"
MsgBox prompt:="c'est la proc2 et c'est un message de toto", _
Title:="toto"
[a1] = "zaza a écrit"
MsgBox prompt:="Bien le bonjour de Bilou", _
Title:="BILOU"
End Sub
'*******************

2) dans un autre classeur, copiez le code ci-dessous qui comporte
une Sub "proc1". Celle-ci appelle la "proc2" de "zaza.xls".
'*******************
Option Explicit
'### L'affectation au variant MesTitres ###
'### sera à adapter plus bas dans proc1 ###
Dim MesTitres As Variant

Dim OnTimer&

Private Declare Function SendMessage& Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)

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

Private Declare Function SetTimer& Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)

Private Declare Function KillTimer& Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long)

Private Declare Function GetWindowText& Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long)
'___________________________
Private Sub CloseMsgBox()
Dim HwndMsgBox&
Dim i&
Dim Ch$
Dim Tampon&
Dim reponse&
For i& = LBound(MesTitres) To UBound(MesTitres)
HwndMsgBox& = FindWindow(vbNullString, MesTitres(i&))
If HwndMsgBox& > 0 Then Exit For
Next i&
If HwndMsgBox& > 0 Then
Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)
Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
End If
End Sub
'___________________________
Private Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf CloseMsgBox)
End Sub
'___________________________
Private Sub OffTimer()
If OnTimer& > 0 Then
OnTimer& = KillTimer(0&, OnTimer&)
OnTimer& = 0
End If
End Sub
'___________________________
Sub proc1()

'*** Code traitement avant appel à proc2 ***

'///// à ajouter à votre code ////
OnTimer& = 0
Call RunTimer(Delai:=0)


'### Mettre les titres des MsgBox à ###
'### cacher dans le Array du Variant ###
'### MesTitres. Cette instruction peut ###
'### être placée en tête de la procédure ###
'### proc1 MAIS avant l'appel à proc2 ###
MesTitres = Array("BILOU", "Microsoft Excel", "toto")


'---- Ici l'appel de proc2 (à adapter)----
Application.Run "zaza.xls!proc2"
'-----------------------------------------
Call OffTimer
'/////////////////////////////////

'*** Code traitement après appel à proc2 ***

End Sub
'*******************

Cela fonctionne chez moi. Qu'en est-il chez vous ?

A vous lire.
Cordialement.

PMO
Patrick Morange

Cette procédure fonctionne aussi chez moi. Tout est donc résolu.

Pour information, originellement, les procédures contenant les MSgBox
s'éxecutent parfois pendant plus de 45 mn.
Je n'ai pas remarqué de ralentissement dans l'invocation par le
fichier d'appel (l'équivalent de votre zaza.xls).

Cela m'a permis notamment de lancer le traitement automatique de
l'ensemble des fichiers, la nuit (temps total d'environ 8 heures)

Merci encore pour la rapidité de vos propositions et de votre
concours, en général.

Cordialement,

DiaRep