Affichage de la date dans une cellule

Public Sub Reset_Effacer_Les_Lignes()
Dim x$
  With Feuil1
    If MsgBox(" Doit t'on vraiment effacer les résultats du tableau ", vbYesNo, " Demande de confirmation d'effacement !!!") = vbYes Then
  
      Range("A3:H200").SpecialCells(xlCellTypeConstants, 23).ClearContents 'Efface la plage sans effacer les formules
      Range("A3:H200").Interior.ColorIndex = xlNone 'On remets le fond (interior) en blanc
      Range("$C$2").FormulaLocal = "=SOMME(DECALER(C3;0;0;NBVAL(F:F)))" 'Ici on recopie la formule de C2 en C2
      '***** Affichage de la date d'aujourd'hui uniquement dans la cellule (A3)
      [A3] = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
      
      With [A3]
        With .Characters(1).Font
            .FontStyle = "Gras"
            .ColorIndex = 3
        End With
        [A3].Font.Name = "Arial"
        [A3].Font.Size = 12
        With .Characters(2).Font
            .FontStyle = "Gras"
            .ColorIndex = xlAutomatic
        End With
        x = InStr(InStr([A1], " ") + 1, [A3], " ")
        With .Characters(x + 1).Font
            .FontStyle = "Gras"
            .ColorIndex = 3
        End With
        [A3].Font.Name = "Arial"
        [A3].Font.Size = 12
        With .Characters(x + 2).Font
            .FontStyle = "Gras"
            .ColorIndex = xlAutomatic
        End With
      End With
    Else
      Exit Sub 'Si réponse = "Non" alors on sort
    End If
  End With
End Sub

'***** Affichage de la date d'aujourd'hui uniquement dans la cellule (A3)

      '***** Affichage de la date d'aujourd'hui uniquement dans la cellule (A3)
      Application.EnableEvents = False      'pour eviter raz par Private Sub Worksheet_Change(ByVal Target As Range) feuil1
      [A3] = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))

'PREMIÈRE LETTRE MAJUSCULE BLEU ET GRAS

Public Sub Majuscule_Bleu_Gras(Cel As Range)
           Dim S As String
Application.ScreenUpdating = False
  With Cel
    S = .Value
    If S = "" Then Exit Sub
    Mid(S, 1, 1) = UCase(Mid(S, 1, 1))        'Majuscule
    .Value = S
    With .Font
            .Name = "Arial"
            .ColorIndex = Noir
            .Bold = True
            .Size = 12
    End With
    
    With .Characters(1, 1).Font
            .Name = "Arial"
            .ColorIndex = Bleu       ' Première lettre
            .Bold = True
            .Size = 12
    End With
  End With
Application.ScreenUpdating = True
End Sub