Discussion :

[Patnel]

Bonjour,

je fais un programme vba qui ouvre, modifie, crée et sauvegarde des fichiers

il arrive souvent que je reçoive un "message système" du style :
"le fichier existe déjà voulez vous le remplacer ?", ou bien d'autres,
je voudrais pouvoir récupérer le texte du message et le traiter par vba, à savoir répondre oui ou non, etc

existe t'il une méthode en vba pouvant effectuer cet exercice ?

[kiki29]

Salut, à adapter à ton contexte

Code :

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

1
2
3
    Application.DisplayAlerts = False
    ' .....
    Application.DisplayAlerts = True

ou

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
Sub Tst()
    On Error GoTo Erreurs
 
    ' .....
Sortie:
    Exit Sub
Erreurs:
    If Err.Number = xx Then
        ' ....
    ElseIf Err.Number = xy Then
        ' ....
    ElseIf Err.Number = xz Then
        ' ....
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
        Err.Clear
        Resume Sortie
    End If
 
    Err.Clear
    Resume Next
End Sub

A voir : La gestion des erreurs dans Excel

[Patnel]

ce n'est pas des erreurs vba que je veux traiter mais les massages émis par Windows dés que je veux traiter un fichier, les même que lorsque je manipule les fichiers sous Windows, et là où on clique à la main le choix désiré, je veux moi que ce soit le programme vba qui le traite, donc je récupère le texte du message et en fonction de la situation que vba connait le programme répondra par ce qu'il doit répondre,
j' ai l'impression que ce que tu me proposes c'est le traitement des erreurs du programme vba.

[AlainTech]

Bonjour,

J'aurais tendance à dire qu'il ne faut pas chercher à intercepter les messages d'erreurs mais faire en sorte que les erreurs ne se produisent pas.

Autrement dit: les prévoir.

[Montor]

il faut donner liste exhaustive des situations sinon c'est impossible .
tu es sous Seven ?

[patricktoulon]

bonsoir

ta question soulève un détail qui me perturbe
tu dis

que tu voudrais intercepter les message entre guillemet"windows du genre blablabla exemple

"le fichier existe déjà voulez vous le remplacer ?", ou bien d'autres,
je voudrais pouvoir récupérer le texte du message et le traiter par vba, à savoir répondre oui ou non, etc

pourquoi veut tu faire ce qui se fait déjà tout seul ?

sinon fait une recherche sur l'expression "hook" mais c'est un sacré boulot (utilisation des apis )

au plaisir

[Montor]

pour fair avancé les choses

Mets le code suivant dans un module standard
utilise la fonction HookCallBack pour intercepter les messages

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
87
88
89
90
91
92
93
94
95
Option Explicit
' MessageBox hook by Montor
Private Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowTextW Lib "user32" (ByVal Hwnd As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowTextLengthW Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function SetWindowsHookExW Lib "user32" (ByVal idHook As Long, ByVal lpfn As Any, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Boolean
Private Declare Function CallNextHookEx Lib "user32" (ByVal hhk As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassNameW Lib "user32" (ByVal Hwnd As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long
 
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
Private Const DLG_CLASS = "#32770"
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const MAX_PATH = 266
Private fHandle As Long
Private Hook As Long
 
Enum IDSExitCode
  ID_OK = 1
  ID_CANCEL = 2
  ID_ABORT = 3
  ID_RETRY = 4
  ID_IGNORE = 5
  ID_YES = 6
  ID_NO = 7
  ID_CLOSE = 8
  ID_HELP = 9
  ID_TRYAGAIN = 10
  ID_CONTINUE = 11
End Enum
 
Private Function WinClass(ByVal Hwnd As Long) As String
Dim Tmp As String
    Tmp = Space(MAX_PATH)
    WinClass = Left(Tmp, GetClassNameW(Hwnd, StrPtr(Tmp), MAX_PATH))
End Function
 
Function BWindow(ByVal H As Long) As Long
    H = GetWindow(H, GW_CHILD)
    Do
       BWindow = H
       H = GetWindow(H, GW_HWNDNEXT)
    Loop Until H = 0
End Function
 
Private Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Txt As String
Dim LHandle As Long
Dim L As Long
  HookProc = CallNextHookEx(Hook, nCode, wParam, lParam)
  On Error GoTo ExitLab
     If (nCode = HCBT_ACTIVATE) Then
        If (WinClass(wParam) = DLG_CLASS) Then
            StopHook
            fHandle = wParam
            LHandle = BWindow(wParam)
            L = GetWindowTextLengthW(LHandle)
            Txt = Space(L)
            GetWindowTextW LHandle, StrPtr(Txt), L + 1
            HookCallBack Txt
            fHandle = 0
        End If
    End If
ExitLab:
End Function
 
Private Sub DlgExitCode(ByVal AExit As IDSExitCode)
   If (fHandle <> 0) Then
        EndDialog fHandle, AExit
        fHandle = 0
   End If
End Sub
 
Sub StartHook()
  If Hook <> 0 Then Exit Sub
  fHandle = 0
  Hook = SetWindowsHookExW(WH_CBT, AddressOf HookProc, Application.Hinstance, 0)
End Sub
 
Sub StopHook()
  If Hook <> 0 Then
     UnhookWindowsHookEx Hook
     Hook = 0
     fHandle = 0
  End If
End Sub
 
Private Sub HookCallBack(ByVal MessageText As String)
   MsgBox "Message :" & vbCr & "[" & MessageText & "]"
   'placer le code interception ici 
   DlgExitCode ID_NO  'simule click No
End Sub

code de test

Code :

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

1
2
3
4
5
6
7
8
9
Sub test()
On Error GoTo FreeHook
StartHook
    'essaie enregistrer une copie dans le meme endroie et avec le meme nom 
    ActiveWorkbook.SaveAs ActiveWorkbook.FullName
 
FreeHook:
   StopHook
End Sub

je vais me pencher sur la question pour faire un diagnostique sur la fiabilité
de telles manipulations

je suis curieux pour ta réponse

[patricktoulon]

wouawhh montor la tu fait fort

cela dit getwindowtext te donne souvent le text de la caption de la fenetre et non le contenu

mais ca reste un sacré moulin

et moi aussi je suis curieux de savoir si chez toi CDO marche bien et encore plus ou tu es allez cherche ton 1 er code qui soit disant serait le mien
qui prenait en compte les MDP

bravo pour ton "hooking"


edit :

je viens de l'essayer et je ne sais pas l'effet que tu a voulu faire mais chez moi queudale rien de nouveau ce me fait exactement la meme chose que sans code
au plaisir

[Montor]

Merci
pour comprendre comment ça fonction alors le handle de fenêtre est passer par le paramètre wParam et après on fait un boucle pour trouver le handle de dernier control de type Static avec BWindow et enfin getwindowtext le texte de ce dernier


pour le CDO le code fonctionnait il y trois ans sur mon ancien compte Gmail mais

mon compte hotmail problème chez eux ils veulent arrêter ce service l'an prochain .

[Patnel]

Bon il y a du nouveau je vois.
Mon problème a l'air d’intéresser du monde.
Merci à Mentor
J'ai essayé brut de pomme ta méthode mais je suis comme sœur Anne je ne vois rien venir.

Si je n'utilise pas les méthode "Hook", le message Système apparait ( ceci répond à la question de AlainTech). Mais si je l'utilise rien ne se passe, le message système n'apparait pas. Je ne vois pas où vba peut gérer la réponse au message système : tu peux expliquer.

[patricktoulon]

Bonjour

Alors l'idée de montor n'était pas si mauvaise en fin de compte.
Par contre c'est son utilisation qui n'était forcément adaptée à ton cas .
Dans le code qu'il t'a donné, à un moment on peut récupérer les chaînes de caractères que constitue les titres des fenêtres ainsi que leurs contenus.
C'est là qu'il faut que tu agisses.

Je te laisse méditer la question.

[Montor]

Mais si je l'utilise rien ne se passe, le message système n'apparait pas

du doit faire le teste sur un fichiers qui est déjà enregistré sur ton pc si tu fait le test avec un nouveau tu dois cliquer deux fois ...

Je ne vois pas où vba peut gérer la réponse au message système

il serait inutile d'aller plus loin les messages windows ne fournissent aucune d'autre information supplémentaire.

placer uniqument le code de gestion des interrogations dans la fonction HookCallBack récupérer le texte de message via MessageText pour savoir le contextes de sa déclenchement.



@patricktoulon

[Montor]

chose que j'ai fait

Code :

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

1
2
3
4
5
Private Sub HookCallBack(ByVal MessageText As String)
   MsgBox "Message :" & vbCr & "[" & MessageText & "]"
   'placer le code interception ici 
   DlgExitCode ID_NO  'simule click No
End Sub

maintenant comprends pourquoi cela ne fonctionne pas sous EXCEL2007
changer le code de la fonction BWindow

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Function BWindow(ByVal H As Long) As Long
    H = GetWindow(H, GW_CHILD)
    Do
       BWindow = H
       If GetWindowTextLengthW(H) <> 0 Then
          If WinClass(H) <> "Button" Then
             Exit Do
          End If
       End If
       H = GetWindow(H, GW_HWNDNEXT)
    Loop Until H = 0
End Function

[Patnel]

je n'ai pas pu continuer sur le sujet car j' ai du passé sur un autre programme plus urgent pour ma boite.

en tout cas je remercie Mentor et Patrick, les infos données vont être exploitées dès que je peux.

je clos la discussion pour ne pas donner des boutons au webmester, qui n'aime pas les discussions qui traient.

Bonne année à tous

[AlainTech]

Bonjour,

Dommage que tu te sois entêté à vouloir aller dans une direction complexe alors qu'on t'a proposé de nous montrer des exemples de cas à traiter.

Mais tu es tellement certain que la solution doit être compliquée que tu restes sourd à nos propositions.

Vraiment dommage...