MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018
-
8 janv. 2014 à 18:45
MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018
-
16 mai 2014 à 17:16
Bonjour à tous,
Je me tourne vers vous car le problème ci-contre me chagrine depuis ce matin. En effet, je cherche à faire un code vba compatible 32 et 64 bits.
Le souci est que je tombe sur une "erreur de compilation : incompatibilité de type" sur la procédure
AddressOf LowLevelMouseProc
dans le Sub Hook_Mouse.
Je ne comprends pas pourquoi? Pouvez-vous m'éclairer de vos lumières?
Le bout de code sert à permettre l'exécution de la molette dans les combobox.
'-----Allows use of MouseWheel on designated ListBox/ComboBox on a form or, sheet if modified.-------- Option Explicit
#If Win64 Then Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Declare PtrSafe Function SetWindowsHookEx Lib _ "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _ ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare PtrSafe Function GetLastError Lib "kernel32" () As Long ' Used this one to crack the problem. #Else Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long ' Used this one to crack the problem. #End If
Type POINTAPI X As Long Y As Long End Type
Type MSLLHOOKSTRUCT 'Will Hold the lParam struct Data pt As POINTAPI mouseData As Long ' Holds Forward\Bacward flag flags As Long time As Long dwExtraInfo As Long End Type
Dim hhkLowLevelMouse, lngInitialColor As Long Dim udtlParamStuct As MSLLHOOKSTRUCT
Public Const GWL_HINSTANCE = (-6) Public intTopIndex As Integer Public ObjUSF As UserForm, ObjList As Object
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT ' VarPtr returns address; LenB returns size in bytes. CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct) GetHookStruct = udtlParamStuct End Function
Function LowLevelMouseProc _ (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'Avoid XL crashing if RunTime error occurs due to Mouse fast movement On Error Resume Next ' \\ Unhook & get out in case the application is deactivated If GetForegroundWindow <> FindWindow("ThunderDFrame", ObjUSF.Caption) Then UnHook_Mouse Exit Function End If If (nCode = HC_ACTION) Then If wParam = WM_MOUSEWHEEL Then '\\ Don't process Default WM_MOUSEWHEEL Window message LowLevelMouseProc = True '\\ Change Sheet&\DropDown names as required With ObjList '\\ if rolling forward increase Top index by 1 to cause an Up Scroll If GetHookStruct(lParam).mouseData > 0 Then .TopIndex = intTopIndex - 1 '\\ Store new TopIndex value intTopIndex = .TopIndex Else '\\ if rolling backward decrease Top index by 1 to cause _ '\\a Down Scroll .TopIndex = intTopIndex + 1 '\\ Store new TopIndex value intTopIndex = .TopIndex End If End With End If Exit Function End If LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam) End Function
Sub Hook_Mouse() ' Statement to maintain the handle of the hook if clicking outside of the control. ' There isn't a Hinstance for Application, so used GetWindowLong to get handle. If hhkLowLevelMouse < 1 Then hhkLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, _ GetWindowLong(FindWindow("ThunderDFrame", ObjUSF.Caption), GWL_HINSTANCE), 0) End Sub
Sub UnHook_Mouse() If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse hhkLowLevelMouse = 0 End If End Sub
Je vous remercie par avance pour votre aide et vous souhaite une très bonne année et pleins de bonnes choses, soit dit en passant.
Cordialement,
Anthony
A voir également:
Le code contenu dans ce projet doit etre mis a jour
Erreur de compilation vba 64 bits - Meilleures réponses
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 Modifié par ucfoutu le 9/01/2014 à 08:08
Bonjour,
les types sont à reconsidérer si 64 bits.
Ex :
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
===>>
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
je te laisse traiter tes autres fonctions (je ne veux pas participer plus à ce genre d'appli)
PS : j'observe que tu ne prévois aucune compilation conditionnelle en fonction de la version Office/VBA ! ===>> c'est selon moi une erreur car traitement différent selon les cas. Les types ne sont à modifier comme montré en exemple
que si conjonction de deux conditions
: OS en 64 bits ET version VBA7 et non uniquement en fonction de l'OS !
Bonne chance
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018 9 janv. 2014 à 10:24
Bonjour ucfoutu,
Merci pour ta réaction. Je ne comptait pas sur toi pour tout changer mais me dire d'où cela peut provenir. Je vais essayer en changeant tous les long en longptr.
Donc tu pense qu'il est préférable de faire des conditions en if win64 & vba7?
En fait, j'essaie de faire une procédure compatible sur tous les office et os windows. Donc si on a un xp 64 bits avec un office 2007, il faut aussi évaluer ce cas. Je n'arrive pas à trouver sur le net une lite des API qui soit pour le vba7 et pour le win64.
tu n'aurais pas une petite idée.
Merci encore pour ton aide.
Cordialement,
Anthony
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 9 janv. 2014 à 13:19
Je crois t'avoir tout dit plus haut :
1) double compilation conditionnelle ; en tenant compte de l'OS, d'une part, et de la version Office, de l'autre.
2) Je refuse d'aller au-delà de ce que je t'en ai dit, s'agissant d'un mécanisme qui :
- soit tend à un sous-classement
- soit tant à "harponner"
(je ne le fais que pour moi et en courant mes risques. Cours les tiens comme tu l'entends. Ces risques existent et surgissent à la moindre erreur).
MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018 9 janv. 2014 à 13:33
Non ce mécanisme, je l'ai trouvé sur le net. Il me permet d'utiliser la roulette de la souris dans un combobox pour faire défiler les différents choix de la liste. Si tu as une meilleure idée je suis preneur.
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 9 janv. 2014 à 14:58
Je ne t'ai nullement parlé de sa finalité, mais de la méthode (harponnage) !
Je te laisse maintenant seul avec tes audaces.
MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018 9 janv. 2014 à 17:19
bonjour
J'ai le même soucis où je voudrais avoir un code 32 et 64 bit pour utiliser la souris pour le défilement dans une ListeBox et du moment que ça marche !
Merci de votre aide
MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018 16 mai 2014 à 14:10
Bonjour
surpris d'avoir réponse aussi rapide
mais c'est justement avec ce code que je bug ( post 6) alors qu'apparemment pour toi il fonctionne et erreur sur Sub Hook_Mouse()
à : LowLevelMouseProc
je regarde en ce moment sur
http://www.jkp-ads.com/articles/apideclarations.asp et en particulier :
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
#Else
Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
#End If
MEUCORACAO
Messages postés35Date d'inscriptionjeudi 30 juin 2011StatutMembreDernière intervention23 octobre 2018 16 mai 2014 à 17:16
Malheureusement, je ne vois pas en quoi la différence entre office 2010 et 2013 fait que cela ne fonctionne pas. Je suis resté sous office 2010 car office 2013 bug un peu trop à mon goût. Je n'ai pas réussi à rester en page de programmation plus de 5 minutes d'affilé sans que le logiciel plante. Je suis désolé mais je ne peux pas te répondre, j'en suis incapable.
Je vais essayer sur un pc avec office 2013 et j'essaie de te dire. Si tu trouves, je veux bien la solution.
Bon courage,
9 janv. 2014 à 10:24
Merci pour ta réaction. Je ne comptait pas sur toi pour tout changer mais me dire d'où cela peut provenir. Je vais essayer en changeant tous les long en longptr.
Donc tu pense qu'il est préférable de faire des conditions en if win64 & vba7?
En fait, j'essaie de faire une procédure compatible sur tous les office et os windows. Donc si on a un xp 64 bits avec un office 2007, il faut aussi évaluer ce cas. Je n'arrive pas à trouver sur le net une lite des API qui soit pour le vba7 et pour le win64.
tu n'aurais pas une petite idée.
Merci encore pour ton aide.
Cordialement,
Anthony
9 janv. 2014 à 13:19
1) double compilation conditionnelle ; en tenant compte de l'OS, d'une part, et de la version Office, de l'autre.
2) Je refuse d'aller au-delà de ce que je t'en ai dit, s'agissant d'un mécanisme qui :
- soit tend à un sous-classement
- soit tant à "harponner"
(je ne le fais que pour moi et en courant mes risques. Cours les tiens comme tu l'entends. Ces risques existent et surgissent à la moindre erreur).
9 janv. 2014 à 13:33
9 janv. 2014 à 14:58
Je te laisse maintenant seul avec tes audaces.
9 janv. 2014 à 17:19