Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "BD" Then Exit Sub
Sh.Activate
[F:G].Validation.Delete
If Intersect(ActiveCell, Range(IIf([F1] Like "Th?me", "F2:F", "G2:G") & Rows.Count)) Is Nothing Then Exit Sub
ActiveCell.Validation.Add xlValidateList, Formula1:="=" & [théme].Address(External:=True) 'voir orthographe de théme...
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Sh.Range(IIf(Sh.[F1] Like "Th?me", "F2:F", "G2:G") & Sh.Rows.Count)) Is Nothing Or Target.Count > 1 Then Exit Sub
Dim mem$
Application.ScreenUpdating = False
If Target <> "" Then
Application.EnableEvents = False
On Error GoTo 1 'si revalidation manuelle
Application.Undo: mem = Target: Application.Undo
If mem <> "" Then If MsgBox("Faut-il ajouter ce thème au(x) thème(s) de la cellule ?", 4) = 7 Then mem = ""
Target = IIf(mem = "", "", mem & vbLf) & Target
Target.WrapText = mem <> "" 'renvoi à la ligne
1 Application.EnableEvents = True
End If
Target.EntireRow.AutoFit 'ajustement hauteur
If Target.RowHeight < 20 Then Target.RowHeight = 20
End Sub