Macro modifié rajout couleur police

Bonsoir,

j'ai récupéré une macro et je voudrai la modifier en important en plus de la couleur de la cellule,

• la couleur de la police
• aussi lier la macro à une cellule de validation

comment faire s'il vous plaît ?

merci du support

Sub CreePlanIndividuel()
  Set planning = Sheets("planIndiv")
  Set bd = Sheets("BD")
  planning.[c4:AG15].ClearComments
  planning.[c4:AG15].ClearContents
  planning.[c4:AG15].Interior.ColorIndex = xlNone
  Nom = planning.[B1]
  For lig = 2 To bd.[A65000].End(xlUp).Row
    If UCase(bd.Cells(lig, 1)) = UCase(Nom) Then
       If bd.Cells(lig, 2) <> "" Then
        jd = Day(bd.Cells(lig, 2))
        md = Month(bd.Cells(lig, 2))
        typeConges = bd.Cells(lig, 4)
        durée = bd.Cells(lig, 3) - bd.Cells(lig, 2) + 1
        nbj = Day(DateSerial(planning.[A1], md + 1, 0))
        For d = 0 To durée - 1
          If jd + d <= nbj Then
           planning.Range("b3").Offset(md, jd + d).Interior.ColorIndex = _
             Sheets("CODES-HORAIRES").[MesCouleurs].Find(typeConges, LookAt:=xlWhole).Interior.ColorIndex

           planning.Range("b3").Offset(md, jd + d) = typeConges
          Else
            planning.Range("b3").Offset(md + 1, jd + d - nbj).Interior.ColorIndex = _
             Sheets("CODES-HORAIRES").[MesCouleurs].Find(typeConges, LookAt:=xlWhole).Interior.ColorIndex

            planning.Range("b3").Offset(md + 1, jd + d - nbj) = typeConges
          End If
        Next d
       End If
    End If
  Next lig
End Sub

Bonsoir

Pour la couleur de la police, rajoute les 2 lignes

Sub CreePlanIndividuel()
  Set planning = Sheets("planIndiv")
  Set bd = Sheets("BD")
  planning.[c4:AG15].ClearComments
  planning.[c4:AG15].ClearContents
  planning.[c4:AG15].Interior.ColorIndex = xlNone
  Nom = planning.[B1]
  For lig = 2 To bd.[A65000].End(xlUp).Row
    If UCase(bd.Cells(lig, 1)) = UCase(Nom) Then
      If bd.Cells(lig, 2) <> "" Then
        jd = Day(bd.Cells(lig, 2))
        md = Month(bd.Cells(lig, 2))
        typeConges = bd.Cells(lig, 4)
        durée = bd.Cells(lig, 3) - bd.Cells(lig, 2) + 1
        nbj = Day(DateSerial(planning.[A1], md + 1, 0))
        For d = 0 To durée - 1
          If jd + d <= nbj Then
            planning.Range("b3").Offset(md, jd + d).Interior.ColorIndex = _
                      Sheets("CODES-HORAIRES").[MesCouleurs].Find(typeConges, LookAt:=xlWhole).Interior.ColorIndex
           planning.Range("b3").Offset(md, jd + d).Font.Color = _
                      Sheets("CODES-HORAIRES").[MesCouleurs].Find(typeConges, LookAt:=xlWhole).Font.Color

            planning.Range("b3").Offset(md, jd + d) = typeConges
          Else
            planning.Range("b3").Offset(md + 1, jd + d - nbj).Interior.ColorIndex = _
                      Sheets("CODES-HORAIRES").[MesCouleurs].Find(typeConges, LookAt:=xlWhole).Interior.ColorIndex
            planning.Range("b3").Offset(md + 1, jd + d - nbj).Font.Color = _
                      Sheets("CODES-HORAIRES").[MesCouleurs].Find(typeConges, LookAt:=xlWhole).Font.Color

            planning.Range("b3").Offset(md + 1, jd + d - nbj) = typeConges
          End If
        Next d
      End If
    End If
  Next lig
End Sub

Pour lier la macro, il faut utiliser une procédure événementielle

Sans le module de la feuille (clic droit sur l'onglet de la feuille --> Visualiser le code) copie le code suivant en modifiant l'adresse de la cellule de validation de données

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$H$3" Then
    CreePlanIndividuel
  End If
End Sub

Bonsoir Banzai64,

j'ai suivi tes instructions, tout marche très bien à présent !

merci de ton aide je peux continuer mon projet, heureusement qu'il y a des gens compétents et sympa