Public cel As Range
Public Function WindowXYFromPoint(x, y): WindowXYFromPoint = ExecuteExcel4Macro("CALL(""user32"",""WindowFromPoint"",""JJJ""," & x & ", " & y & ")"): End Function
Public Function ShowOnCell(cel As Range, Optional modal As Boolean = vbModal)
With UserForm2: Set .cel = cel: .Show modal: End With
End Function
Function placeOnRange(RNG As Range)
Dim h2&, H1&, PtPx#, EcX&, Ecy&
With ActiveWindow.ActivePane
PtPx = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72 'coeff pixel
If Not RNG Is Nothing Then x = .PointsToScreenPixelsX(RNG.Left): y = .PointsToScreenPixelsY(RNG.Top)
End With
EcX = Round(Me.Width - Me.InsideWidth) * PtPx 'ecart maximum toléré par la fonction en pixel
Ecy = Round(Me.Height - Me.InsideHeight) * PtPx 'ecart maximum toléré par la fonction en pixel
H1 = WindowXYFromPoint(x, y)
With Me
.StartUpPosition = 0
.Left = (x / PtPx * ActiveWindow.Zoom / 100) + 15 ' je deregle la position exemple je le met à -100 de left
.Top = (y / PtPx * ActiveWindow.Zoom / 100) + 15 ' je deregle la position exemple je le met à +10 de top
End With
'correction Left
h2 = WindowXYFromPoint(x, y + Ecy)
If h2 <> H1 Then
Do While h2 <> H1 And b < 100: Me.Left = Me.Left + 0.1: h2 = WindowXYFromPoint(x, y + Ecy): b = b + 1: Loop: Me.Left = Me.Left - 1
Else
b = 0
Do While h2 = H1 And b < 100: Me.Left = Me.Left - 0.1: h2 = WindowXYFromPoint(x, y + Ecy): b = b + 1: Loop: Me.Left = Me.Left - 1
End If
'correction top
h2 = WindowXYFromPoint(x + EcX, y)
If h2 <> H1 Then
b = 0
Do While h2 <> H1 And b < 100: Me.Top = Me.Top + 0.1: h2 = WindowXYFromPoint(x + EcX, y): b = b + 1: Loop: Me.Top = Me.Top - 1
Else
b = 0
Do While h2 = H1 And b < 100: Me.Top = Me.Top - 0.1: h2 = WindowXYFromPoint(x + EcX, y): b = b + 1: Loop: Me.Top = Me.Top - 1 'on le repousse donc en bas
End If
End Function
'////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_Activate()
If cel Is Nothing Then Set cel = [D5]
placeOnRange cel
End Sub