Comment faire afficher un message?

Bonjour le forum

Je voudrais lorsque je clic 2 fois le même jour sur colonne A pour faire afficher la date ça affiche "date existe déjà" dans macro ci-dessous

Merci pour vos éventuels retours

Cordialement

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Init  'Module posologie
If Target.Column = 1 Then Target.Value = Date: Cancel = True
  If Not Intersect(Range("C3:C" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
    Cancel = True
    If Range("A" & Target.Row) = "" Then
      MsgBox "Double Click Cellule A3 pour Afficher la date"
      Exit Sub
    End If

    Target = IIf(Target = "VITAMINE D2 & D3", "", "VITAMINE D2 & D3")
  ElseIf Not Intersect(Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
    Cancel = True
    Target = IIf(Target = NbAmpoule, "", NbAmpoule)  'NBAmpoule à la place de 1 à condition que le module Posologie soit présent

  End If
    If Target.Column = 9 And Target.Row >= 2 And Target.Row <= 106 Then
Application.EnableEvents = False
        With ActiveCell.Offset(0, -8).Resize(1, 8)
            .Font.Strikethrough = Not .Font.Strikethrough
            ActiveCell = IIf(ActiveCell.Offset(0, -8).Font.Strikethrough, "Oui", "Non")
        End With

        With ActiveCell
            If .Offset(0, -8) <> "" And .Offset(0, -8).Font.Strikethrough = True Then
                .Interior.ColorIndex = 35
                .Font.ColorIndex = 3
            Else
                .Interior.ColorIndex = 46
                .Font.ColorIndex = 5
            End If
        End With
    End If
Cancel = True
Application.EnableEvents = True
End Sub

Bonjour

Essaie ça :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Init  'Module posologie
    Cancel = True
If Target.Column = 1 Then
    If Target = "" Then
        Target.Value = Date
    Else
        MsgBox "La date existe déjà.", 16
        Exit Sub
    End If
End If
  If Not Intersect(Range("C3:C" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
    Cancel = True
    If Range("A" & Target.Row) = "" Then
      MsgBox "Double Click Cellule A3 pour Afficher la date"
      Exit Sub
    End If

    Target = IIf(Target = "VITAMINE D2 & D3", "", "VITAMINE D2 & D3")
  ElseIf Not Intersect(Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
    Cancel = True
    Target = IIf(Target = NbAmpoule, "", NbAmpoule)  'NBAmpoule à la place de 1 à condition que le module Posologie soit présent

  End If
    If Target.Column = 9 And Target.Row >= 2 And Target.Row <= 106 Then
Application.EnableEvents = False
        With ActiveCell.Offset(0, -8).Resize(1, 8)
            .Font.Strikethrough = Not .Font.Strikethrough
            ActiveCell = IIf(ActiveCell.Offset(0, -8).Font.Strikethrough, "Oui", "Non")
        End With

        With ActiveCell
            If .Offset(0, -8) <> "" And .Offset(0, -8).Font.Strikethrough = True Then
                .Interior.ColorIndex = 35
                .Font.ColorIndex = 3
            Else
                .Interior.ColorIndex = 46
                .Font.ColorIndex = 5
            End If
        End With
    End If
Cancel = True
Application.EnableEvents = True
End Sub

Bye !

Bonjour gmb

Ça ne fonctionne pas

J'en ai une qui fonctionne mais comment la placer?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Range("D3:D" & Rows.Count), Target) Is Nothing Then   'c'est A à la place de D 
     Application.EnableEvents = False
    If Target <> "" Then
      If Not IsError(Application.Match(CSng(Date), Columns("A"), 0)) Then                   'Interdire le même jour
        MsgBox "Un Prélèvement existe déjà à cette date"                                                 'Interdire le même jour
        Target = ""
      End If
    End If
    Range("A" & Target.Row) = IIf(Target = "", "", Date)
  End If
  Application.EnableEvents = True
End Sub

al87 a écrit :

Ça ne fonctionne pas

Bye !

Bonjour gmb

Après réfexion pas indispensable pour ce fichier au contraire car je programme pour 3 fois tous les 2 mois (23 février 23 avril et 23 juin) donc si je met "date existe déjà" je ne pourrais pas le faire sinon le lendemain et j'aurais oublié!!!

Merci à toi

Ne te fais pas de souci je reviendrais ... même vite!!!

Bonne journée à toi

Cordialement