Bonjour le forum,
Voici avec un DoubleClick la première partie de la macro pour mettre en % et un autre pour effacer et remettre en €:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne As Long, Cel As Range, Couleur As Integer
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B9:B" & Rows.Count), Target) Is Nothing Then
Range("A" & Target.Row) = IIf(Target = "", "", Date)
If Target = "" Then
Couleur = Target.Offset(-1, -1).Interior.ColorIndex
Ligne = Target.Row
While Left(Range("A" & Ligne), 5) <> "Série"
Ligne = Ligne - 1
Wend
Set Cel = Range("A3:A8").Find(what:=Range("A" & Ligne), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Couleur = Cel.Interior.ColorIndex
End If
Unprotect
'Target.Interior.ColorIndex = Target.Offset(0, -1).Interior.ColorIndex
With Target.Offset(0, -1).Resize(1, 9)
.ClearContents
.Interior.ColorIndex = Couleur
End With
Protect
End If
ElseIf Not Intersect(Range("I10:I" & Rows.Count), Target) Is Nothing And Target = "" Then
Target.NumberFormat = "#,##0.00 $"
End If
End Sub
Deuxième partie de la macro
Case 9 ' Colonne I
Application.EnableEvents = False
If Target = 1 Then
Target.NumberFormat = "#,##0.00 $"
Target.ClearContents
Else
Target = 1
Target.NumberFormat = "00 %"
End If
Application.EnableEvents = True
ActiveSheet.Protect
Cancel = True
Exit Sub
End Select
Cancel = True
Bonne journée à vous tous
Cordialement