Fonction MsgBoxPerso - Version 64 bits

Hello le forum,

Après quelques heures de recherche, je me permet de posté.

J'ai sur l'un de mes fichiers une fonction de MsgBox personnalisé (qui provient de : https://www.mdf-xlpages.com/modules/publisher/item.php?itemid=42)

Cependant, je viens de passer sur la version 64 bits, et vous vous en doutez, j'ai des problèmes.

Après quelques adaptation, une ligne me pose encore problème... Il s'agit de la ligne :

AddressOf CaptionBoutons,

Private Declare PtrSafe Function SetWindowsHookEx& Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&)
Private Declare PtrSafe Function GetCurrentThreadId& Lib "kernel32" ()
Private Declare PtrSafe Function CallNextHookEx& Lib "user32" _
        (ByVal hHook&, ByVal CodeNo&, ByVal wParam&, ByVal lParam&)
Private Declare PtrSafe Function GetWindow& Lib "user32" (ByVal hWnd&, ByVal wCmd&)
Private Declare PtrSafe Function SetWindowText& Lib "user32" Alias "SetWindowTextA" _
        (ByVal hWnd&, ByVal lpString$)
Private Declare PtrSafe Function UnhookWindowsHookEx& Lib "user32" (ByVal hHook&)
Private msgHook&
Private TitreBtn$(1 To 2)
Function MsgBoxPerso(Prompt$, Optional Title$, Optional Icon&, Optional Caption1$ = "Oui", _
    Optional Caption2$ = "Non", Optional Cancel As Boolean = False) As Byte
Dim Rep%, hInstance&
    TitreBtn(1) = Caption1
    TitreBtn(2) = Caption2
    msgHook = SetWindowsHookEx(5, AddressOf CaptionBoutons, hInstance, GetCurrentThreadId())
    Rep = MsgBox(Prompt, Icon + IIf(Cancel, vbYesNoCancel, vbYesNo), Title)
    MsgBoxPerso = Application.Max(Rep - 5, 0)
    Erase TitreBtn
End Function

Private Function CaptionBoutons&(ByVal nCode&, ByVal wParam&, ByVal lParam&)
Dim hWndChild&
  If nCode < 0 Then
    CaptionBoutons = CallNextHookEx(msgHook, nCode, wParam, lParam)
    Exit Function
  End If
  If nCode = 5 Then
    hWndChild = GetWindow(wParam, 5)
    Call SetWindowText(hWndChild, TitreBtn(1))
    hWndChild = GetWindow(hWndChild, 2)
    Call SetWindowText(hWndChild, TitreBtn(2))
    UnhookWindowsHookEx msgHook
  End If
  CaptionBoutons = False
End Function
Function MailAdress()
Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object, myitem As Object
Dim User As String
    Set OL = CreateObject("outlook.application")
    Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
    User = OL.Session.CurrentUser.Name
    Set oentry = olAllUsers.Item(User)
    Set oExchUser = oentry.GetExchangeUser()
    'MsgBox
    oExchUser.PrimarySmtpAddress
End Function

Connaissez-vous une solution ?

Merci d'avance pour votre aide.

Kilian

Bonjour,
Un élément de réponse, pour les déclarations.
Cdlt.

Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr

Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Declare PtrSafe Function GetWindow Lib "user32" _
        (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr

Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
        (ByVal hwnd As LongPtr, ByVal lpString As String) As Long

Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As LongPtr) As Long

Salut,

A mettre bien au chaud...

Re,
Bonjour Jean-Paul,
Mes données proviennent de ton zip, diffusé récemment.
Cdlt.

Salut, Jean-Eric

Merci, cela fait du bien de savoir que l'on est lu.

Hello Jean-Eric, Jean-Paul,

Merci pour vos réponses.

En enlevant juste le As LongPtr de la déclaration de la fonction SetWindowsHookEx, ça marche très bien.

Merci à vous deux !

Bon week-end,

Kilian