Mfc

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range
Dim C As Range
Dim R As Range
'---
'##############################
'### Première mise en forme ###
'### D Interior.ColorIndex  ###
'##############################
'--- On détermine la plage où s'opère l'action (à adapter)---
Set Plage = Range("c5:c" & Range("c5").End(xlDown).Row & "")
'--- Balayage de chaque cellule de la plage ---
For Each C In Plage
  '--- La condition  ET l'action ---
  If C = "D" Then
    C.Interior.ColorIndex = 40
  Else
    C.Interior.ColorIndex = xlNone
  End If
Next C

'#########################################
'###      Deuxième mise en forme       ###
'### D Border et 1ère cellule à gauche ###
'#########################################
'--- On détermine la plage où s'opère l'action (à adapter) ---
Set Plage = Range("c5:c" & Range("c5").End(xlDown).Row & "")
'--- Balayage de chaque cellule de la plage ---
For Each C In Plage
  '--- L'union de D Border et 1ère cellule à gauche ---
  Set R = Application.Union(C, C.Offset(0, -1))
  '--- La condition  ET l'action ---
  With R.Borders(xlEdgeBottom)
    If C = "D" Then
      .LineStyle = xlContinuous
      .Weight = xlThin
      '.... autres propriétés éventuellement
      .Color = vbBlue
    Else
      .LineStyle = xlNone
    End If
  End With
Next C

'... autres actions ...
'...
'...
End Sub

'--- On détermine la plage où s'opère l'action (à adapter)---
Set Plage = Range("c5:c" & Range("c5").End(xlDown).Row & "")

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call MFCpmo1
End Sub

Dim T() As Variant  'Tableau à 2 dimensions
                    'Dimension 1 => booléenne qui indique si la condition est vérifiée OU non
                    'Dimension 2 => string : l'adresse de la cellule
Dim Tcompteur&  'Compteur de tableau

Sub SetMFC_pmo(Optional dummy As Byte)
Dim C As Range
'---
Set C = Application.Caller
'--- Tableau de l'adresse des cellules ---
Tcompteur& = Tcompteur& + 1
ReDim Preserve T(1 To 2, 1 To Tcompteur&)
T(1, Tcompteur&) = False
T(2, Tcompteur&) = C.Address

'### La condition est-elle vérifiée ###
If C = "D" Then T(1, Tcompteur&) = True

End Sub

Sub MFCpmo1(Optional dummy As Byte)
Dim R As Range
Dim R2 As Range
Dim i&
'---
For i& = 1 To Tcompteur&
  Set R = Range(T(2, i&))
  '---
  Set R2 = Application.Union(R, R.Offset(0, -1))
  '---
  If T(1, i&) = True Then
  
'### Application de la mise en forme ###
    '--- Couleur du fond ---
    R.Interior.Color = vbYellow
    '--- La police ---
    With R.Font
      .Bold = True
      .Italic = True
    End With
    '--- Bordure inférieure ---
    R2.Borders(xlEdgeBottom).LineStyle = xlContinuous
    R2.Borders(xlEdgeBottom).Weight = xlThin
    R2.Borders(xlEdgeBottom).Color = vbBlack
  Else
    R.Interior.Pattern = xlNone
    '---
    With R.Font
      .Bold = False
      .Italic = False
    End With
    '---
    R2.Borders(xlEdgeBottom).LineStyle = xlNone
'#######################################
    
  End If
Next i&
'--- Réinitialisation du tableau ---
Erase T
Tcompteur& = 0
End Sub