Autres [RÉSOLU] macro à modifier

[un internaute]

Bonjour le forum
Je fait afficher une date puis l’effacer ou pas mais surtout je voudrais lui faire dire que si je double click dans cellule en dessous la date existe déjà
Merci pour vos évetuels retours

Option Explicit
Dim I As Integer
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1), Target) Is Nothing Then
    Cancel = True
    Application.EnableEvents = False
    If Target = "" And Application.Match(CSng(Date), Columns("G"), 0) > 0 Then
        MsgBox "Cette date existe déjà"
        GoTo Sortie
    End If
    If Target <> "" And Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then
        If Target.Value <> "" Then
            If MsgBox("Effacer la date?", vbYesNo) = vbYes Then
                On Error Resume Next
                Target.Resize(, 7).SpecialCells(xlCellTypeConstants, 23).ClearContents
                On Error GoTo 0
                Target.Resize(, 7).Interior.ColorIndex = 8
            End If
        End If
      Else
        Target.Offset(, 6).Value = Date
        Target = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
      End If
    End If
Sortie:
    Application.EnableEvents = True
    Range("A1").Select
End Sub

 

[un internaute]

Bonjour le forum
Voilà

Option Explicit
Dim DerLig As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    If DerLig < 3 Then DerLig = 3
    If Not Intersect(Range("A3:A" & DerLig + 1), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        Debug.Print Date * 1
        Debug.Print Target.Offset(-1, 0).Value
        If IsEmpty(Target) And Application.WorksheetFunction.CountIf(Range("A2:A" & DerLig), Format(Date, "dddd dd mmmm yyyy")) > 0 Then
            MsgBox "Cette date existe déjà"
            GoTo Sortie
        End If
        If Target <> "" And Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then
            If Target.Value <> "" Then
                If MsgBox("Effacer la date?", vbYesNo) = vbYes Then
                    On Error Resume Next
                    Target.Resize(, 7).SpecialCells(xlCellTypeConstants, 23).ClearContents
                    On Error GoTo 0
                    Target.Resize(,7).Interior.ColorIndex = 8
                End If
            End If
          Else
            Target.Offset(, 6).Value = Date
            Target = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
          End If
    End If
Sortie:
    Application.EnableEvents = True
    Range("A1").Select
End Sub