Comment faire afficher un message?
a
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
g
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 !
a
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
g
a
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