Re,
Pas sûr d'avoir bien pigé la macro. Peut-être comme ça :
Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Indice As Integer, NbColonne As Integer
Dim Tb, TbCoul, X, TbFont, Label As String
Select Case UCase(sh.Name) ' Cette ligne permet de modifier l'onglet. Exemple "Changement" sans modifier la macro "CHANGEMENT HEURE APPAREILS"
Case "CHANGEMENT HEURE APPAREILS"
NbColonne = 3
End Select
If Target.Column = NbColonne + 1 And Target.Row >= 3 And Range("A" & Target.Row) <> "" Then
Application.EnableEvents = False
TbFont = Array(5, 1, 1)
TbCoul = Array(35, 40, 8)
Tb = Array("", "Oui", "Non")
Cancel = True
X = UCase(Trim(Target))
If UBound(Filter(Tb, X, compare:=vbTextCompare)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Label = Tb(Indice)
With Target
.Value = Label
.Interior.ColorIndex = TbCoul(Indice)
.Font.ColorIndex = TbFont(Indice)
.Offset(0, 1).Value = DateSerial(Year(Date), Month(Date), Day(Date)) '<===== Le changement est ici
End With
With ActiveCell.Offset(0, -NbColonne).Resize(1, NbColonne)
If Label = "Oui" Then
.Font.Strikethrough = True
Else
.Font.Strikethrough = False
End If
End With
End If
Application.EnableEvents = True
End If
Range("A1").Select
End Sub