Mise en forme cellule

Bonjour a tous,

J'ai cherché un peu partout sans trouver (ou peut être ne pas comprendre).

J'ai des cellule avec des noms de couleurs et des numéros en dessous (il peut y a voir des lettres dans ces numéros)

Ce que j'aimerais c'est de mettre les noms des couleurs dans une certaine forme (taille plus petite et en italique par ex) et la ligne du dessous (en couleur gras et plus gros (ex:)

j'arrive a faire une mise en forme, mais a chaque fois c'est la cellule complète.

Bien sur en VBA, manuellement j'y arrive ;-)

Merci déjà pour vos réponses

Bonjour,

Un essai ...

Sub Macro1()
Dim Str As Variant
Dim LLig As Integer, CCol As Integer
Dim Cl As Range

    Application.ScreenUpdating = False

    LLig = ActiveSheet.UsedRange.Rows.Count
    CCol = ActiveSheet.UsedRange.Columns.Count

    For Each Cl In ActiveSheet.Range(Cells(1, 1), Cells(LLig, CCol))
        If Cl <> "" Then
            With Cl
                Str = Split(Cl, vbLf)

                With .Characters(Start:=1, Length:=Len(Str(0))).Font
                    .Name = "Calibri"
                    .FontStyle = "Italique"
                    .Size = 9
                    .OutlineFont = False
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontMinor
                End With

                With .Characters(Start:=Len(Str(0)) + 1, Length:=Len(Cl) - Len(Str(0))).Font
                    .Name = "Calibri"
                    .FontStyle = "Gras"
                    .Size = 12
                    .OutlineFont = False
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontMinor
                End With
            End With
        End If
    Next Cl
End Sub

ric

ric a écrit :

Bonjour,

Un essai ...

Sub Macro1()
Dim Str As Variant
Dim LLig As Integer, CCol As Integer
Dim Cl As Range

    Application.ScreenUpdating = False

    LLig = ActiveSheet.UsedRange.Rows.Count
    CCol = ActiveSheet.UsedRange.Columns.Count

    For Each Cl In ActiveSheet.Range(Cells(1, 1), Cells(LLig, CCol))
        If Cl <> "" Then
            With Cl
                Str = Split(Cl, vbLf)

                With .Characters(Start:=1, Length:=Len(Str(0))).Font
                    .Name = "Calibri"
                    .FontStyle = "Italique"
                    .Size = 9
                    .OutlineFont = False
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontMinor
                End With

                With .Characters(Start:=Len(Str(0)) + 1, Length:=Len(Cl) - Len(Str(0))).Font
                    .Name = "Calibri"
                    .FontStyle = "Gras"
                    .Size = 12
                    .OutlineFont = False
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontMinor
                End With
            End With
        End If
    Next Cl
End Sub

ric

Merci,

C'est exactement ce que je voulais.

ric

Bonjour Damsa17, ric, le forum,

J'arrive trop tard, mais vu que je me suis pris la tête , je poste quand même....

C'est légèrement différent de ric, mais je constate que j'étais sur la bonne voie,

CTRL + e pour éxécuter la macro

Sub essai()
 Dim i As String, j As String
 Dim derlig As Long, dercol As Integer
 Dim cel As Range, chaine

 Application.ScreenUpdating = False

  With Sheets("Feuil1")
   derlig = .UsedRange.Rows.Count
   dercol = .UsedRange.Columns.Count

    For Each cel In Range(.Cells(1, 1), .Cells(derlig, dercol))
      If cel <> "" And InStr(cel, vbLf) Then
       For Each chaine In cel
        i = Len(Left(chaine, InStr(cel, Chr(10)) - 1))
        j = Len(Mid(chaine, InStr(cel, Chr(10)) + 1))
       Next chaine
         With cel
         .Characters(Start:=1, Length:=i).Font.Size = 9: .Characters(Start:=1, Length:=i).Font.Color = vbRed: .Characters(Start:=1, Length:=i).Font.Bold = False: .Characters(Start:=1, Length:=i).Font.Italic = True
         .Characters(Start:=i + 2, Length:=j).Font.Size = 12: .Characters(Start:=i + 2, Length:=j).Font.Color = vbBlue: .Characters(Start:=i + 2, Length:=j).Font.Bold = True
         End With
      End If
    Next cel
  End With
End Sub

Cordialement,