ok je vais regarderVoilà le fichier débarrassé des autres méthodes avec seulement la méthode WindowFromPoint qui est la seule qui soit généraliste et relativement simple. J'ai gardé ma méthode "profondeur" pour les ComboBoxes UserForm mais tu peux te faire plaisir et la remplacer par la tienne. Pareil pour le Pane de l'Objet.
Oui c'est normal car les ListBoxes on a le résultat immédiatement.il s'avere que pour les listbox tu n'y fait pas appel et les combo oui c'est normal
a ben grosse erreur justementJe sais pas trop la définition.
Quand c'est la feuille qui est Parent j'ai considéré Control ActiveX pour les différencier des Controls de Formulaire. Et Control de UserForm quand c'est le UserForm qui est Parent.
Il est possible que les 2 soient ActiveX, je ne me suis jamais posé la question.
Ok, alors tu m'apprends quelque chose !il y a les controls formulaire et les activx c'est tout
Function ObjectPane(obj As Object)
Dim psX As POINTAPI, panIndex&
GetCursorPos psX
panIndex = 1
With ActiveWindow
If .Panes.Count >= 2 Then If psX.x > .Panes(2).PointsToScreenPixelsX(.Panes(2).VisibleRange.Left) Then panIndex = 2
If .Panes.Count >= 2 Then If psX.y < .Panes(2).PointsToScreenPixelsY(.Panes(2).VisibleRange.Top) Then panIndex = 1
If .Panes.Count = 4 Then If psX.y > .Panes(3).PointsToScreenPixelsY(.Panes(3).VisibleRange.Top) Then panIndex = panIndex + 2
Set ObjectPane = .Panes(panIndex)
[B1] = "Panes(" & panIndex & ")"
End With
End Function
Ok, alors tu m'apprends quelque chose !
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Function CursorPane() As Pane
Dim Hold As POINTAPI
Dim Pan As Pane
Dim i As Integer
GetCursorPos Hold
With ActiveWindow
For i = 1 To .Panes.Count
With .Panes(i)
If Hold.x >= .PointsToScreenPixelsX(.VisibleRange.Left) _
And Hold.x < .PointsToScreenPixelsX(.VisibleRange.Left + .VisibleRange.Width) _
And Hold.y >= .PointsToScreenPixelsY(.VisibleRange.Top) _
And Hold.y < .PointsToScreenPixelsY(.VisibleRange.Top + .VisibleRange.Height) Then Exit For
End With
Next i
Set CursorPane = .Panes(i)
End With
End Function
'---------------------------------
'GetControlHandleByWindowFromPoint
'Ne fonctionne pas pour les Controls de UserForms
'---------------------------------
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongLong) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
#End If
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPtr
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
#If Win64 Then
Function PointToLongLong(point As POINTAPI) As LongLong
Dim ll As LongLong
Dim cbLongLong As LongPtr
cbLongLong = LenB(ll)
' make sure the contents will fit
If LenB(point) = cbLongLong Then
CopyMemory ll, point, cbLongLong
End If
PointToLongLong = ll
End Function
#End If
'---------------------------------
'GetControlHandleByWindowFromPoint
'Ne fonctionne pas pour les Controls de UserForms
'première nouvelle :):)
'---------------------------------
Function GetControlHandleByWindowFromPoint(Ctl As Object) As LongPtr
Dim Hold As POINTAPI, clss$, hwnd&, hwndP&
'Position curseur
GetCursorPos Hold
#If Win64 Then
hwnd = WindowFromPoint(PointToLongLong(Hold))
#Else
hwnd = WindowFromPoint(Hold.x, Hold.y)
#End If
'ListBox
Select Case True
Case TypeOf Ctl Is MSForms.ListBox
GetControlHandleByWindowFromPoint = hwnd
Exit Function
Case TypeName(Ctl) = "ComboBox"
clss = Space$(255)
hwndP = GetParent(hwnd)
GetClassName hwndP, clss, 255
If InStr(1, clss, "F3 MdcPopup") = 0 Then hwnd = 0 ' si c'est un popu alors
End Select
GetControlHandleByWindowFromPoint = hwnd
End Function
je le redis :Je suis allé un peu vite en besogne car RangeFromPoint retourne une Shape si elle est sous le curseur, et là ça ne marche plus