XL 2021 bug "lib32" suite à passage à office 2021

[fredl]

Bonjour,
suite à recherche infructueuse sur le forum, je me permets de faire appel à vos lumières.
Récemment passé à office 2021 (et donc de 32bit à 64 bit?), j'ai un ensemble de fonctions qui buggent comme celle ci dessous (msgbox qui permet de personnaliser le type de réponses possibles).
Je vous mets tout le code en bas sachant que le code buggue sur la declaration de fonction ci dessous :

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 CallNextHookEx& Lib "USER32" _
(ByVal hHook&, ByVal CodeNo&, ByVal wParam&, ByVal lParam&)
Private Declare Function GetWindow& Lib "USER32" (ByVal Hwnd&, ByVal wCmd&)
Private Declare Function SetWindowText& Lib "USER32" Alias "SetWindowTextA" _
(ByVal Hwnd&, ByVal lpString$)
Private Declare Function UnhookWindowsHookEx& Lib "USER32" (ByVal hHook&)
Private msgHook&
Private TitreBtn$(1 To 2)


Une modification simple est elle envisageable? (ex remplacement Lib "USER32" par autre chose?)
merci beaucoup pour votre aide.


Module complet :

'===============================================================================================
' !!!ATTENTION affiche les bouton oui/non/annulé si lancé du vba!!!(fonctionne tres bien)
'===============================================================================================

' varReponse = MsgBoxPerso(prompt [, title] [, icon] [, caption1] [, caption2] [, cancel ])
' Comme pour une MsgBox 'classique', seul l'argument message est obligatoire :
' --------------------------------------------------------------------------
' prompt : chaîne de caractères correspondant au texte à afficher
' title : [facultatif] chaîne de caractères représentant le titre
' icon : [facultatif] valeur identique que pour une MsgBox classique
' constantes : vbCritical, vbQuestion, vbExclamation ou vbInformation
' caption1 : [facultatif] chaîne de caractères correspondant au titre du bouton n°1
' caption2 : [facultatif] chaîne de caractères correspondant au titre du bouton n°2
' cancel : [facultatif] affiche un bouton Annuler dans la boîte de dialogue si = True
'
'
' Valeur de retour :
' ----------------
' Le choix de l'utilisateur est renvoyé sous forme d'une valeur (type Byte) de 0 à 2 :
'
' 0 : l'utilisateur a cliqué sur le bouton Annuler
' 1 : l'utilisateur a cliqué sur le bouton n° 1
' 2 : l'utilisateur a cliqué sur le bouton n° 2
'
'===============================================================================================
'
'bug 2021 (passage à 64 bit?)
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 CallNextHookEx& Lib "USER32" _
(ByVal hHook&, ByVal CodeNo&, ByVal wParam&, ByVal lParam&)
Private Declare Function GetWindow& Lib "USER32" (ByVal Hwnd&, ByVal wCmd&)
Private Declare Function SetWindowText& Lib "USER32" Alias "SetWindowTextA" _
(ByVal Hwnd&, ByVal lpString$)
Private Declare Function UnhookWindowsHookEx& Lib "USER32" (ByVal hHook&)
Private msgHook&
Private TitreBtn$(1 To 2)


Sub Msgbox3reponses(Optional factice As String)
'le true pour faire apparaitre le annuler - sinon ne rien mettre (fonction a declarer et a recuperer : 2 au total (ds module librairie "msgboxComplexe")
Rep = MsgBoxPerso("Veuillez préciser ce qui doit être récupéré dans le mail", "Question", vbQuestion, "Piece jointe", "Email", True)

Select Case Rep
Case 0 'annuler
MsgBox "annulé!"
Case 1 'PJ
MsgBox "choix PJ"
Case 2 'texte Email
MsgBox "choix texte mail"
End Select
End Sub




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

 

[fredl]

J'ai rectifié le Private Declare Function en Private Declare PtrSafe Function, et maintenant cela bugge sur :

(message d'erreur : "erreur de compilation : Incompatibilité de type")

 

[wDog66]

Bonjour Fredl

Inscrit depuis 2005 et tu ne sais pas encore qu'il faut mettre le code donné entre balises 🤔
Noooonnn sérieux 🤪🤭🤣

 

[fredl]

Merci wDog66 pour ce précieux conseil.
Je rectifie donc de ce pas en espérant que cela aidera à la résolution de mon problème.
Bonne journée.

'===============================================================================================
' !!!ATTENTION affiche les bouton oui/non/annulé si lancé du vba!!!(fonctionne tres bien)
'===============================================================================================

' varReponse = MsgBoxPerso(prompt [, title] [, icon] [, caption1] [, caption2] [, cancel ])
' Comme pour une MsgBox 'classique', seul l'argument message est obligatoire :
' --------------------------------------------------------------------------
' prompt : chaîne de caractères correspondant au texte à afficher
' title : [facultatif] chaîne de caractères représentant le titre
' icon : [facultatif] valeur identique que pour une MsgBox classique
' constantes : vbCritical, vbQuestion, vbExclamation ou vbInformation
' caption1 : [facultatif] chaîne de caractères correspondant au titre du bouton n°1
' caption2 : [facultatif] chaîne de caractères correspondant au titre du bouton n°2
' cancel : [facultatif] affiche un bouton Annuler dans la boîte de dialogue si = True
'
'
' Valeur de retour :
' ----------------
' Le choix de l'utilisateur est renvoyé sous forme d'une valeur (type Byte) de 0 à 2 :
'
' 0 : l'utilisateur a cliqué sur le bouton Annuler
' 1 : l'utilisateur a cliqué sur le bouton n° 1
' 2 : l'utilisateur a cliqué sur le bouton n° 2
'
'===============================================================================================
'
'bug 2021 (passage à 64 bit?)
Private Declare Ptrsafe Function SetWindowsHookEx& Lib "USER32" Alias "SetWindowsHookExA" _
(ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&)
Private Declare Function GetCurrentThreadId& Lib "kernel32" ()
Private Declare Function CallNextHookEx& Lib "USER32" _
(ByVal hHook&, ByVal CodeNo&, ByVal wParam&, ByVal lParam&)
Private Declare Function GetWindow& Lib "USER32" (ByVal Hwnd&, ByVal wCmd&)
Private Declare Function SetWindowText& Lib "USER32" Alias "SetWindowTextA" _
(ByVal Hwnd&, ByVal lpString$)
Private Declare Function UnhookWindowsHookEx& Lib "USER32" (ByVal hHook&)
Private msgHook&
Private TitreBtn$(1 To 2)


Sub Msgbox3reponses(Optional factice As String)
'le true pour faire apparaitre le annuler - sinon ne rien mettre (fonction a declarer et a recuperer : 2 au total (ds module librairie "msgboxComplexe")
Rep = MsgBoxPerso("Veuillez préciser ce qui doit être récupéré dans le mail", "Question", vbQuestion, "Piece jointe", "Email", True)

Select Case Rep
Case 0 'annuler
MsgBox "annulé!"
Case 1 'PJ
MsgBox "choix PJ"
Case 2 'texte Email
MsgBox "choix texte mail"
End Select
End Sub




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

 

[wDog66]

Re,

Une demande à mon ami et voilà ce qu'il me donne

#If VBA7 Then
Private 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
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function CallNextHookEx Lib "USER32" ( _
ByVal hHook As LongPtr, ByVal CodeNo As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindow Lib "USER32" ( _
ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Declare PtrSafe Function SetWindowText Lib "USER32" Alias "SetWindowTextA" ( _
ByVal hwnd As LongPtr, ByVal lpString As String) As Long
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "USER32" (ByVal hHook As LongPtr) As Long
Private msgHook As LongPtr
#Else
Private 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
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function CallNextHookEx Lib "USER32" ( _
ByVal hHook As Long, ByVal CodeNo As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "USER32" ( _
ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetWindowText Lib "USER32" Alias "SetWindowTextA" ( _
ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "USER32" (ByVal hHook As Long) As Long
Private msgHook As Long
#End If

Private TitreBtn(1 To 2) As String

Sub Msgbox3reponses(Optional factice As String)
Dim Rep As Byte
Rep = MsgBoxPerso("Veuillez préciser ce qui doit être récupéré dans le mail", "Question", vbQuestion, "Pièce jointe", "Email", True)

Select Case Rep
Case 0 ' Annuler
MsgBox "annulé !"
Case 1 ' PJ
MsgBox "choix PJ"
Case 2 ' texte Email
MsgBox "choix texte mail"
End Select
End Sub

Function MsgBoxPerso(Prompt As String, Optional Title As String, Optional Icon As VbMsgBoxStyle, _
Optional Caption1 As String = "Oui", Optional Caption2 As String = "Non", Optional Cancel As Boolean = False) As Byte
Dim Rep As VbMsgBoxResult
Dim hInstance As LongPtr
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

#If VBA7 Then
Private Function CaptionBoutons(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim hWndChild As LongPtr
#Else
Private Function CaptionBoutons(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hWndChild As Long
#End If
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 = 0
End Function

A tester 😉

Mais sinon, pourquoi ne pas passer tout simplement par un USF !?

 

[fredl]

Je te remercie pour ta réponse. Effectivement, un USF répond également au besoin, mais j'avais cette solution fonctionnelle bien séduisante que je souhaitais pérenniser dans ma nouvelle version d'office.

 

[fredl]

Je viens de tester : coooool, ça marche!
Merci beaucoup
Fred