[VBA] Récupérer le hModule (ou hInstance) à partir du hWnd ?

Question

Salut ta tou(e)s
Dans un projet sous Word 2003, j'utilise des MsgBox.
Hélas, les MsgBox ont la mauvaise habitude de se placer au centre de l'écran.
Pour des raisons personnelles (et matérielles), je voudrais déplacer cette MsgBox là où je le souhaite.
J'ai donc recourt au SubClassement (cher à Manu) pour détecter l'apparition et identifier de la vraie MsgBox.
Le problème est que la fonction SetWindowsHookEx (user32) que j'utilise me demande le hModule (ou hInstance) de la forme mère.

J'ai pu, sans trop de problème, récupérer le handle de ma fenêtre (UserForm), mais je n'arrive pas à trouver le hModule associé.
Dans WinId que j'utilise pour ce genre de mise au point, ce hModule recherché = &h65000000 et celui du document = &h30000000 : Ce qui m'étonne, c'est la rondeur de ces chiffres.

Quelqu'un connaitrait-il le lien entre le handle et des instances ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

ucfoutu · Answer

Bonjour, Jack,

Pourquoi ne pas plutôt extraire l'id du fil (le dernier paramètre de la fonction) ?
Tupourrais alors (dès lors que ce dernier paramètre est spécifié) utiliser la valeur NULL pour ton hInstance.

(je cherche par ailleurs dans mon fouillis ... je crois y avoir un code VB6 pour placer une msgbox là où on veut). 

____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !

CTAC · Answer

Bonjour,

Voilà, j'ai ça.
Tu y rajoute un MoveWindow ou SetWindowPos.



Private Declare Function SetWindowsHookEx& _
Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook&, ByVal lpfn&, ByVal hMod&, ByVal dwThreadId&)

Private Declare Function GetCurrentThreadId& _
Lib "kernel32" _
()

Private Declare Function UnhookWindowsHookEx& _
Lib "user32" _
(ByVal hHook&)

Private Declare Function DeleteMenu& _
Lib "user32" _
(ByVal hMenu&, ByVal nPosition&, ByVal wFlags&)

Private Declare Function GetSystemMenu& _
Lib "user32" _
(ByVal hwnd&, ByVal bRevert&)

Private lgHook&

Private Function Inhibe&(ByVal lMsg&, ByVal wParam&, ByRef lParam&)
Const SC_CLOSE& &HF060&, MF_BYCOMMAND& &H0&
Const HCBT_ACTIVATE& = 5&
If lMsg = HCBT_ACTIVATE Then
DeleteMenu GetSystemMenu(wParam, False), SC_CLOSE, MF_BYCOMMAND
UnhookWindowsHookEx lgHook
End If
Inhibe = False
End Function

Sub InhibeCloseBouton()
Const WH_CBT& = &H5
lgHook = SetWindowsHookEx(WH_CBT, AddressOf Inhibe, 0&, GetCurrentThreadId)
MsgBox "Boite de message avec Close bouton inhibé.", vbYesNoCancel, "Bouton Obligatoire"
End Sub



ctac

cs_Jack · Answer

ucfoutu, CTAC : merci de vos réponses

ucfoutu : le fil du dernier paramètre ... de SetWindowsHookEx ?
Je le fournis aussi.

CTAC : J'ai bien essayé de lui mettre un joli "ByVal 0&" à la place du hModule et mon dwThreadID est bien fournit avec la même méthode que toi, mais hélas, l'objet qui provoque les déclenchements du Hook est un objet Word "OpusApp", alors qu'une MsgBox est une classe #32770.

C'est là justement qu'est mon problème.
J'ai regardé les Child ou Parent du handle qui déclenche, mais je n'ai trouvé aucune classe #32770.

Renfield · Answer

The hMod parameter must be set to NULL if the dwThreadId parameter specifies a thread created by the current process and if the hook procedure is within the code associated with the current process.

donc ok, avec un beau GetCurrentTheadID  


non ?

Renfield - Admin CodeS-SourceS - MVP Visual Basic

ucfoutu · Answer

Re,
Pas moyen de remettre la main sur ce que je cherchais, mais on va essayer de mémoire :

exemple :
1) là où tu appelmes l'affichage
  On Error GoTo erreur 'juste pour la cas où ...
  Dim Filactu As Long
  Filactu = GetCurrentThreadId() 'Détermination du fil actuel ' fonction GetCurrentThreadId à déclarer, bien évidemment
  affX = ....... 'abscisse d'affichage
  affY = ........ ' ordonnée d'affichage
  hHook = SetWindowsHookEx(WH_CBT, AddressOf Position, 0&, Filactu)
  MsgBox "patatipatata"
  erreur:
end sub

et dans un module bas :


Option Explicit
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public 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
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

'Constantes pour SetWindowPos :
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5

Public hHook As Long
Public affX As Long
Public affY As Long

Public Function Position(ByVal Messg As Long, ByVal Hhandle As Long, ByVal afterhwnd As Long) As Long
  If Messg = HCBT_ACTIVATE Then
    'positionnement du msgbox :
    SetWindowPos Hhandle, 0, affX, affY, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
    DoEvents
    UnhookWindowsHookEx hHook 'Déchargement
  End If
  Position = False
End Function

Ce que tu cherches à faire devrait ressembler à ce qui précede (sauf erreur de ma part)



____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !

ucfoutu · Answer

Je suis prfaitement d'accord avec RenFieleld (c'est ce que j'exprimais dans un  message plus haut )

Essaye le code que je t'ai montré (on verra ensuite où il "faute", s'il faute)___________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !

ucfoutu · Answer

Bon : attention : j'ai oublié la constante WH_CBT dans le module !

On reprend tout :
Voici ce que je viens de tester depuis Excel et qui devrait marcher depuis Word puisque je ne relève même pas le handle de l'userform

Appel, au click d'un bouton de commande sur Userform :

Private Sub CommandButton1_Click()
  Dim Filactu As Long
  Filactu = GetCurrentThreadId() 'Détermination du fil actuel
  affX = 300 ' mon abscisse
  affY = 100 ' mon ordonnée
  'procédure de positionnement pour la prochaine fenêtre à afficher
  hHook = SetWindowsHookEx(WH_CBT, AddressOf Position, 0, Filactu)
  MsgBox "coucou"
End Sub

et dans un module :

Option Explicit
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public 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
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

'Constantes pour SetWindowPos :
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public hHook As Long
Public affX As Long
Public affY As Long

Public Function Position(ByVal Messg As Long, ByVal Hhandle As Long, ByVal afterhwnd As Long) As Long
  If Messg = HCBT_ACTIVATE Then
    'positionnement du msgbox :
    SetWindowPos Hhandle, 0, affX, affY, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
    DoEvents
    UnhookWindowsHookEx hHook 'Déchargement
  End If
  Position = False
End Function
Je te laisse tester avec Word . Marche très bien avec Excel
____________________

Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !

ucfoutu · Answer

OK...
Je viens de tester ce code avec Word ===>> Fonctionne bien...

Te reste toutefois à le rationnaliser/le coiffer un peu, car codé à la va-vite et à la hussarde.
Bonne nuit.


____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !

cs_Jack · Answer

Bah crotte.
J'ai utilisé cette même technique mais moi, il me renvoie un objet dont la classe est "OpusApp", et pas une "#32770"
J'ai rebooté la machine, au cas où, rien n'y fait.
Je vais le remettre sur un Doc vide pour voir, on ne sait jamais, mais bon, je ne fais pas d'autre Hookerie donc je ne vois pas ce qui peut interférer.

Passe-partout, tête de tigre !

Non, y a pas à dire, l'évènement qui enclenche le hook est une classe "ThunderDFrame" maintenant, c'est à dire la classe des UserForm.
Par contre, parmi ces Child, je retrouve une Classe #32770
Tiens bizarre, uniquement quand je fais du pas-à-pas en debug, pas en run simple où le Hook ne se déclenche même pas ...
J'ai tout supprimé le superflux (vérif classe, vérif coordonnées, HookNext, stoppé MzTools ...) : plus rien ne marche, je comprends plus rien.
Ca m'énerffffe !

Juste deux détails : 
- je bosse sous un OS + Office en anglais. 
- La machine est une machine virtuelle
Ca m'étonnerait que cela y change grand chose, mais bon.

En tout cas, merci de vos tuyaux : ça confirme que je suis sur la bonne voie ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_Jack · Answer

Bon, ça y est, c'est retombé en marche.
Je déhookais trop vite : en fait, je déhookais même si le message du hook n'était pas 5 = HCBT_ACTIVATE
Du coup, les appels suivant n'arrivaient plus.
Ah la la, les fautes d'étourderies !

Merci à vous de vous être penché sur ce cas qui relève plus de la cénilité que de la technique. Va falloir faire qqchose ... vacances, trépanation, euthanasie, ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_lermite222 · Answer

Bonjour tou(te)s
Merci à ce fil qui m'a bien aidé.
En fait, quand on a en VB6
xx = App.hInstance
En VBA, il n'y a que de la remplacer par...
xx = GetCurrentThreadId() 
Du moins, chez moi ça roule...
Cdlt.

bigfish_le vrai · Answer

Salut,

cela t'aidera peut être d'aller voir ici
 

Dans cette source la message box est repositionnée en bas à droite.


A+

[VBA] Récupérer le hModule (ou hInstance) à partir du hWnd ?

12 réponses

Votre réponse

Discussions similaires