Microsoft 365 Calendrier dans cellule

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.CountLarge > 1 Or Intersect(Me.[B12:C19], Target) Is Nothing Then Exit Sub
   UFmCalenS.Posit Target, 0, 1
   Target.Value = UFmCalenS.Saisie(Titre:=IIf(Target.Column = 2, "Début", "Fin"), _
      DInit:=Target.Value, Défaut:=Target.Value)
   End Sub

'************************************************************************************************************************************
Public Function GetPointDistanceCellFromTheBorderScreen(Optional Cell As Range = Nothing, Optional IndexPane& = 0)
' collection  Fonctions avec PointsToScrenPixels(X Y) / Activewindow / Activepane / panes(1 to 4) / visiblerange etc...
' récupérer la distance (des bords de l’écran a la cellule désignée)en points théoriques en incluant la gestion du freezepane et multi panne etc....
' version 2.0
' date février 2022
' auteur :patricktoulon
' Code  simplifié
' renvoie un array(1 to 2)(Left,top) ou vide
    Dim PtsToPxX#, PtsToPxy#, TheZoom#, PosXY(1 To 2), PaN As Pane, Eq As Boolean, Addr$, ip&, I&
    With ActiveWindow
        If Cell Is Nothing Then Set Cell = ActiveCell
        Eq = IndexPane > 0: Addr = Cell.Address(0, 0): ip = IndexPane
        If IndexPane > .Panes.Count Or IndexPane = 0 Then Set PaN = .ActivePane: IndexPane = .ActivePane.Index Else: Set PaN = .Panes(IndexPane)
        If .FreezePanes = True Then
            For I = 1 To .Panes.Count
                If Not Intersect(Cell, .Panes(I).VisibleRange) Is Nothing Then Set PaN = .Panes(I)
            Next
        End If
        If Eq = True And Intersect(Cell, .Panes(IndexPane).VisibleRange) Is Nothing Then MsgBox Addr & " n'est pas VISIBLE!!! dans la pane " & ip: Exit Function
        PtsToPxX = ((.Panes(1).PointsToScreenPixelsX(72) - .Panes(1).PointsToScreenPixelsX(0)) / 72)
        PtsToPxy = ((.Panes(1).PointsToScreenPixelsY(96) - .Panes(1).PointsToScreenPixelsY(0)) / 96)
        TheZoom = .Zoom / 100
        PosXY(1) = ((PaN.PointsToScreenPixelsX(Int(Cell.Left)) / PtsToPxX) * TheZoom) + (Cell.Width * TheZoom) 'left en point
        PosXY(2) = ((PaN.PointsToScreenPixelsY(Int(Cell.Top)) / PtsToPxy) * TheZoom) - IIf(Not .FreezePanes, 1, 0)    'top en point
    End With
    GetPointDistanceCellFromTheBorderScreen = PosXY
End Function
'************************************************************************************************************************************