' fonction du calendar patricktoulon reconvertie
Function EmplacementControl(Obj As Object, Optional yy As Single = 0)
If Not Obj Is Nothing Then
Dim Lft As Double, Ltop As Double, P As Object, PInsWidth As Double, PInsHeight As Double, tt As Double
Dim K As Double, PPx, A, Z
Lft = Obj.Left ' Normalement Page, Frame ou UserForm
Ltop = Obj.top
Set P = Obj.Parent
Dim zoo#
With ActiveWindow: zoo = .Zoom / 100: PPx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 * zoo) - .Panes(1).PointsToScreenPixelsX(0)) / 7200): End With
Do
PInsWidth = P.InsideWidth ' Le Page en est pourvu, mais pas le Multipage.
PInsHeight = P.InsideHeight
If TypeOf P Is MSForms.Page Then Set P = P.Parent ' Prend le Multipage, car le Page est sans positionnement.
K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): Ltop = (Ltop + P.top + P.Height - K - PInsHeight)
If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
Set P = P.Parent
DoEvents
Loop
'pour la combobox on considère que le rectangle est le top à la position du curseur+3 left et right
'il ne peut pas y avoir de raté
If yy > 0 Then tt = Int(Ltop + Obj.Height + yy) + 3 Else tt = Ltop + Obj.Height
EmplacementControl = Array(Lft / PPx, Ltop / PPx, (Lft + Obj.Width) / PPx, tt / PPx)
End If
End Function