Microsoft 365 Calendrier : Modifier Target > change R

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Hour(Now) < 8 Then
'If [a1] < 8 Then
MsgBox ([a1].Value & " heures lol" & Chr(10) & "C'est trop tôt pour travailler !") '& Chr(10) &
[a1].Select
Exit Sub
End If

Target = ""
Dim DatMin As Date, DatMax As Date
Select Case LCase(Sh.Name)
Case "saisierdv":
     ' CELLULE(E14)- en majuscule - Date en cours à +3mois avec heure obligatoire
    If Target(1).Address(False, False) = "E7" Then 'voir si besoin code "suivisappels"
       DatMin = Date      '<date en cours
       DatMax = Date + 90 '<date en cours +90jrs
       Application.EnableEvents = False
       fmSTD_Calendrier.SelectDateCELL2 DatMin, DatMax  '< saisie date qui sera collée dans la cellule active
       If IsDate(Target.Value) Then fm_SaisieHeure.Show '< saisie heure(que s'il y a une date sur cell)
       Application.EnableEvents = True: Cancel = True: Exit Sub
     ' CELLULE(G8) - Date en cours à +/-3mois avec/sans saisie heure
    ElseIf Target(1).Address(False, False) = "G6" Then
       DatMin = Date + 1 '<date en cours -90jrs
       DatMax = Date + 90 '<date en cours +90jrs
       Application.EnableEvents = False
       fmSTD_Calendrier.SelectDateCELL2 DatMin, DatMax  '< saisie date qui sera collée dans la cellule active
       'If IsDate(Target.Value) Then fm_SaisieHeure.Show '< saisie heure(que s'il y a une date sur cell)
       Application.EnableEvents = True: Cancel = True: Exit Sub
    End If
     ' COLONNE(V) à partir de la ligne(7) (test dern.lig/Col(A)
     ' saisie à la Date en cours avec/sans saisie heure
Case "suivisappels":
       If Cells(ActiveCell.Row, 1) = "" Then
'       MsgBox ("y a rien sur cette ligne !") '& Chr(10) &
'       [a1].Select
'       Exit Sub
'       Else
       If Not Application.Intersect(Target, Range("j7:j31")) Is Nothing Then
       '--------------------------------------------------------------------------------
       'ancien code col 22
       'NoLig = Target(1).Row: PremLig = 7: NoCol = 10
       DernLig = Cells(Rows.Count, "A").End(xlUp).Row
       'If Target(1).Column <> NoCol Or NoLig < PremLig Or NoLig > DernLig Then Exit Sub
        '--------------------------------------------------------------------------------
       DatMin = Date   'date en cours
       DatMax = Date + 365 'date en cours +365 jrs à voir!?
       Application.EnableEvents = False
       fmSTD_Calendrier.SelectDateCELL2 DatMin, DatMax  '< saisie date qui sera collée dans la cellule active
       On Error Resume Next
       If IsDate(Target.Value) Then fm_SaisieHeure_SAp.Show '< saisie heure(que s'il y a une date sur cell)
       Application.EnableEvents = True: Cancel = True: Exit Sub
       End If
       End If
End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("j7:j31")) Is Nothing Then
If Hour(Now) < 8 Then
'If [a1] < 8 Then
MsgBox ([a1].Value & " heures lol" & Chr(10) & "C'est trop tôt pour travailler !") '& Chr(10) &
[a1].Select
Exit Sub
End If

R = ""
Dim DatMin As Date, DatMax As Date
Select Case LCase(Sh.Name)
Case "saisierdv":
     ' CELLULE(E14)- en majuscule - Date en cours à +3mois avec heure obligatoire
    If R(1).Address(False, False) = "E7" Then 'voir si besoin code "suivisappels"
       DatMin = Date      '<date en cours
       DatMax = Date + 90 '<date en cours +90jrs
       Application.EnableEvents = False
       fmSTD_Calendrier.SelectDateCELL2 DatMin, DatMax  '< saisie date qui sera collée dans la cellule active
       If IsDate(R.Value) Then fm_SaisieHeure.Show '< saisie heure(que s'il y a une date sur cell)
       Application.EnableEvents = True: Cancel = True: Exit Sub
     ' CELLULE(G8) - Date en cours à +/-3mois avec/sans saisie heure
    ElseIf R(1).Address(False, False) = "G6" Then
       DatMin = Date + 1 '<date en cours -90jrs
       DatMax = Date + 90 '<date en cours +90jrs
       Application.EnableEvents = False
       fmSTD_Calendrier.SelectDateCELL2 DatMin, DatMax  '< saisie date qui sera collée dans la cellule active
       'If IsDate(R.Value) Then fm_SaisieHeure.Show '< saisie heure(que s'il y a une date sur cell)
       Application.EnableEvents = True: Cancel = True: Exit Sub
    End If
     ' COLONNE(V) à partir de la ligne(7) (test dern.lig/Col(A)
     ' saisie à la Date en cours avec/sans saisie heure
    Case "suivisappels":
       If Cells(ActiveCell.Row, 1) = "" Then
'       MsgBox ("y a rien sur cette ligne !") '& Chr(10) &
'       [a1].Select
'       Exit Sub
'       Else
'       If Not Application.Intersect(R, Range("j7:j31")) Is Nothing Then
       '--------------------------------------------------------------------------------
       'ancien code col 22
       'NoLig = R(1).Row: PremLig = 7: NoCol = 10
       DernLig = Cells(Rows.Count, "A").End(xlUp).Row
       'If R(1).Column <> NoCol Or NoLig < PremLig Or NoLig > DernLig Then Exit Sub
        '--------------------------------------------------------------------------------
       DatMin = Date   'date en cours
       DatMax = Date + 365 'date en cours +365 jrs à voir!?
       Application.EnableEvents = False
       fmSTD_Calendrier.SelectDateCELL2 DatMin, DatMax  '< saisie date qui sera collée dans la cellule active
       On Error Resume Next
       If IsDate(R.Value) Then fm_SaisieHeure_SAp.Show '< saisie heure(que s'il y a une date sur cell)
       Application.EnableEvents = True: Cancel = True: Exit Sub
       End If
'       End If
End Select
End If
EnD Sub