Question desactivation msgbox

**EngueEngue** · 01/10/2013, 15h20

Bonjour les amis,

Je viens de recevoir un tool d'un consultant qui fait des calculs qui prennent des heures...

Je suis en train de construire un tool qui me permet de lancer une suite de calculs à la suite en faisant appel à ce classeur.

A la fin des calculs j'ai plusieurs msgbox qui s'affichent et qui stoppent donc ma macro.. Ce qui m'embête, je pourrais toucher au code pour virer ces msgbox mais j'aimerais laisser ce tool tel quel.

Des idées?

Merci

**Marc-L** · 01/10/2013, 15h25

Bonjour,

tu peux légèrement modifier le code du tool en lui passant un paramètre booléen pour afficher ou non les messages …

**EngueEngue** · 01/10/2013, 15h34

Bonne idée, cependant le tool fait dans les 20k lignes de code et me plonger dedans serait assez chiant!

Qui dit mieux?

Il n'y aurait pas moyen de détecter un affichage de msgbox, ou inhiber leur affichage, ou demander que le code continue ?

**Marc-L** · 01/10/2013, 15h39

Sinon si c'est toujours le même nombre de messages affichés et toujours appuyer sur le même bouton par défaut,
il faudrait injecter dans le buffer clavier autant de retours …

Mais pas toujours fiable avec un applicatif VBA.

**EngueEngue** · 01/10/2013, 15h45

Les temps des calculs sont très variables.. C'est toujours deux msgbox avec un ok seulement.. donc oui mais il faut détecter leur affichage

**PMO2017** · 01/10/2013, 15h46

Bonjour,

Si cela peut aider, voici un exemple de fermeture de MsgBox indésirable.
Le code ci-dessous ferme la MsgBox indésirable, l'important est de connaître son titre car son identification se fait par lui.

Copiez le code suivant dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
'### Adapter la constante selon le Titre de la MsgBox ###
Private Const TITRE_MSGBOX As String = "zaza"
'########################################################
 
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)
 
 
Const WM_CLOSE As Long = &H10
 
'___________________________
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&, WM_CLOSE, 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 monTraitement()
 
  '*** Code traitement avant l'apparition du message ***
 
'///// à ajouter à votre code ////
OnTimer& = 0
Call RunTimer(Delai:=1000)  'j'ai mis le délai à 1 seconde pour voir ce qui se passe (1000 millisecondes)
'Call RunTimer(Delai:=0)
 
'---- Ici : simulation d'un message indésirable (à virer)----
MsgBox prompt:="coucou", Title:="zaza"
'------------------------------------------------------------
 
Call OffTimer
'/////////////////////////////////
 
  '*** Code traitement après fermeture du message ***
 
 
End Sub

Lancez la procédure monTraitement pour faire un test.

**Marc-L** · 01/10/2013, 15h56

Tout dépend du nombre de fenêtres avec différends titres pour ne pas trop ralentir ses 20k lignes de code …

**EngueEngue** · 01/10/2013, 15h59

Ca tue.. Ca ralentit mais vu que les calculs durent des heures.. Et que je veux en lancer une bonne quinzaine à la suite, la machine est partie pour 1 semaine de calculs, une heure de plus ou de moins..

Merci PMO, tu déchires!

J'ai mis le timer à 100000 perdre 100 secondes ne dérange en rien.

Je laisse la discussion ouverte s'il y a d'autres magiciens!

**PMO2017** · 01/10/2013, 16h27

Marc-L Tout dépend du nombre de fenêtres avec différents titres

Voilà une version traitant plusieurs MsgBoxes avec des titres différents que j'avais fait paraître en 2008. Je me contente de la recopier.

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) ?

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
'*******************
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".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
'*******************
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

**EngueEngue** · 01/10/2013, 16h52

J'ai en effet passé les titres des msgbox en Array et cela marche très bien.

Par contre ce genre de timer est assez gourmand.. Si une inspiration divine te vient n'hésite pas à la partager.

Encore merci!

**PMO2017** · 01/10/2013, 18h11

Si tu arrives à identifier vers quel endroit de ton programme apparaît la MsgBox indésirable, tu peux placer l'instruction Call RunTimer dans ces parages puis l'instruction Call OffTimer quelques temps après.
********
On peut également simuler un clic souris à partir d'un autre classeur tournant dans une autre instance d'Excel. Cependant, il faut connaître l'emplacement du bouton "OK" et la fenêtre Excel doit être au premier plan ce qui empêche de travailler sur une autre application.
Je peux construire un exemple si cela t'intéresse. Tiens moi au courant.

Bonne soirée et à plus.

**EngueEngue** · 01/10/2013, 19h25

Mon ordi ne travaille que sur ces calculs.. En effet, j'ai un classeur qui a des données qu'il va injecter dans le classeur qui calcule.

Je ne peux pas modifier le code du classeur qui calcule..

Le bouton ok est toujours au même endroit, mais comment savoir quand le msgbox apparait sans mettre de timer ?

**Marc-L** · 01/10/2013, 20h10

Là aussi cela sent l'usine !

T'as vérifié je suppose qu'il n'y a pas moyen d'accélérer le processus …

Récemment sur un autre forum un code prenait 103 189 itérations pour le calcul
comparé à ma procédure en ayant seulement besoin de 21 pour un résultat plus fin !

**EngueEngue** · 02/10/2013, 09h29

au niveau du classeur de calculs ?

Les consultants l'ont codé avec les pieds, pour les end(xlup) ils utilisent des boucles while jusqu'à 20000 lignes, ils font des boucles avec barres de défilement pour faire joli, ils privilégient le copiage sur feuille aux tableaux et il n'y a pas de screenupdating=false.

Mais.. ce n'est pas mon travail de passer une semaine à comprendre et à nettoyer le code.

**Marc-L** · 02/10/2013, 12h24

Oui t'as raison, programmé avec des pieds ‼

Dans une procédure chargeant un référentiel prenant 48 secondes, rien qu'en enlevant la barre de défilement, j'en ai gagné 30 !
Ensuite en optimisant, la procédure prend à peine plus de 2 secondes …
Et ce seulement lors du premier appel mais d'origine c'était 48 secondes à chaque appel ! …
Le problème est que les utilisateurs ne voulaient pas croire que ma nouvelle procédure fonctionne bien
vu qu'ils étaient habitués depuis des années à patienter et qu'on ne leur avait pourtant pas changé leur ordinateur !

**EngueEngue** · 02/10/2013, 12h26

Si ma boss me demande de l'optimiser je le ferais, en attendant, le programme met 6 h à tourner pour 1250 indicateurs... (il construit des triplets, donc jolie compléxité) Si j'en mets 2000 plus d'une semaine.

**PMO2017** · 02/10/2013, 17h01

Bonjour,

Une autre piste employant une macro de fermeture à partir d'une autre instance d'Excel.
L'intérêt est que la macro s'effectue dans un processus différent et n'interfère pas avec le programme principal.

Code a copier dans un module standard d'un nouveau classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
'### Adaptez les constantes selon votre usage ###
Private Const TITRE_MSGBOX As String = "zaza"   'Titre exact de la MsgBox indésirable
Private Const DELAI As String = "00:00:30"      'Intervalle d'exécution pour la récursivité ("00:00:30" = toutes les 30 secondes)
'################################################
 
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 Const WM_CLOSE As Long = &H10
 
Sub CloseMsgBoxIndesirable()
Dim Hwnd&
Hwnd& = FindWindow(vbNullString, TITRE_MSGBOX)
If Hwnd& <> 0 Then SendMessage Hwnd&, WM_CLOSE, 0, ByVal 0&
 
'--- Rappel de la procédure selon un délai ---
Application.OnTime Now + TimeValue(DELAI), "CloseMsgBoxIndesirable"
End Sub

Il faut sauvegarder le classeur et l'ouvrir dans une autre instance d'Excel.

On ouvre les classeurs principaux avec la démarche normale.
Pour ouvrir ce classeur dans une autre instance d'Excel il faut ouvrir Excel puis faire menu Ouvrir.

Question desactivation msgbox

Macros et VBA Excel

Discussions similaires

Partager

Partager