Autres toutes version excel tester le calendar en mode modal et non modal sur range ou control dans userform

Op = Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ")))
    appv = Val(Application.Version)

#If VBA7 Then
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xpoint As Long, ByVal ypoint As Long) As Long
#Else
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xpoint As Long, ByVal ypoint As Long) As Long
#End If

Sub test2222()
    hwndA = Application.hwnd
    x = ActiveWindow.ActivePane.PointsToScreenPixelsX([C3].Left)
    y = ActiveWindow.ActivePane.PointsToScreenPixelsY([C3].Top)
    h1 = WindowFromPoint(x, y)    'on capte le handle de la fenetre qui ce trouve a ce point  precis!!!!!
    With UserForm1
        .StartUpPosition = 0
        .Left = (x / PtoPX * ActiveWindow.Zoom / 100)
        .Top = (y / PtoPX * ActiveWindow.Zoom / 100)
        .Show 0
    End With

    'correction left
    h2 = WindowFromPoint(x, y + 20)    'on prend un point sur X de left  <<<<un peu plus bas de 20 pixel>>>>
    If h2 <> h1 Then    'si les deux handle sont différent(ca veux dire qu'il est décaler a droite)
        'on le rammene a gauche tant que h1 et h2 sont différents
        Do While h2 <> h1: UserForm1.Left = UserForm1.Left + 0.1: h2 = WindowFromPoint(x, y + 20): Loop
    Else    'sinon ca veut dire qu'il mange un peu le left
        Do While h2 = h1: UserForm1.Left = UserForm1.Left - 0.1: h2 = WindowFromPoint(x, y + 20): Loop    'on le repousse donc a droite
    End If

    'correction top(ben on fait pareil symetriquement parlant
    h2 = WindowFromPoint(x + 20, y)    'on prend un point <<<un peu plus a droitede 20 pixel>>>>  mais sur Y pilpoil
    If h2 <> h1 Then    'si les deux handle sont différent(ca veux dire qu'il est décaler en bas )
        'on le rammene en top Y tant que h1 et h2 sont différents
        Do While h2 <> h1: UserForm1.Top = UserForm1.Top + 0.1: h2 = WindowFromPoint(x + 20, y): Loop
    Else    'sinon ca veut dire qu'il mange un peu le top
        Do While h2 = h1: UserForm1.Left = UserForm1.Left - 0.1: h2 = WindowFromPoint(x + 20, y): Loop    'on le repousse donc en bas
    End If
End Sub
Public Function PtoPX()
    With ActiveWindow.ActivePane
        PtoPX = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72    'coeff
    End With
End Function

Sub testX()
    UserForm1.ShowOnCell [c3], 0
End Sub

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 UserForm1: Set .cel = cel: .Show modal: End With
End Function

Function correction()
    Dim x#, y#, h2&, h1&, PtPx#, EcX&, EcY&
    With ActiveWindow.ActivePane
        x = .PointsToScreenPixelsX(cel.Left): y = .PointsToScreenPixelsY(cel.Top)
        PtPx = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72    'coeff
    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) - 100    ' je deregle la position exemple je le met à -100 de left
        .Top = (y / PtPx * ActiveWindow.Zoom / 100) + 100   ' je deregle la position exemple je le met à +10 de top
        .Show 0
    End With
    'correction top
    h2 = WindowXYFromPoint(x + EcX, y)
    If h2 <> h1 Then
        Do While h2 <> h1: Me.Top = Me.Top + 0.1: h2 = WindowXYFromPoint(x + EcX, y): Loop
    Else
        Do While h2 = h1: Me.Top = Me.Top - 0.1: h2 = WindowXYFromPoint(x + EcX, y): Loop    'on le repousse donc en bas
    End If

    'correction Left
    h2 = WindowXYFromPoint(x, y + EcY)
    If h2 <> h1 Then
        Do While h2 <> h1: Me.Left = Me.Left + 0.1: h2 = WindowXYFromPoint(x, y + EcY): Loop
    Else
        Do While h2 = h1: Me.Left = Me.Left - 0.1: h2 = WindowXYFromPoint(x, y + EcY): Loop
    End If
End Function
'////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////

Private Sub UserForm_Activate()
    If Not cel Is Nothing Then correction
End Sub