Problème de fonctionnement d'une macro de formats personnalisés

Bonjour, je n'arrive pas à faire fonctionner cette macro.

Cette macro a pour but de modifier les caractéristiques d'affichage en

fonction du contenu : le gras, l'italique, le soulignement, la police et

la taille de caractère.

Sub MiseEnEvidence()

Action.Execute MiseEnEvidence Until ActiveCell=""

DependingOn.Case ActiveCell

Case Is >= 10

Selection.Police.IndexColor = 3

Selection.Police.Bold = True

Case 5 To 9

Selection.Police.Underline = xlMono

Case 1 To 4

Selection.Police.Size = 18

Case 0

Selection.Police.IndexColor = 2

End DependingOn

ActiveCell.Shift(1, 0).Active

Loop

End Sub

Bonjour

A tester

Sub MiseEnEvidence()
    Do While Not IsEmpty(ActiveCell)
        Select Case ActiveCell.Value
            Case Is >= 10
                ActiveCell.Font.ColorIndex = 3 ' Couleur rouge
                ActiveCell.Font.Bold = True
            Case 5 To 9
                ActiveCell.Font.Underline = xlUnderlineSingle ' Soulignement simple
            Case 1 To 4
                ActiveCell.Font.Size = 18 ' Taille de police 18
            Case 0
                ActiveCell.Font.ColorIndex = 2 ' Couleur verte
        End Select

        ' Passer à la cellule suivante
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Si cela convient passes le sujet en résolu

Crdlt

Bonjour à tous,

Et si la colonne est longue, une version optimisée :

Public Sub MiseEnEvidenceOptimisee()
    Application.ScreenUpdating = False
    ' Définir la feuille de travail
    Dim ws As Worksheet: Set ws = ActiveSheet

    ' Boucle sur les cellules à partir de la cellule active vers le bas
    Dim cellI As Range
    For Each cellI In ws.Range(ActiveCell, ws.Cells(ws.Rows.Count, ActiveCell.Column).End(xlUp))
        If IsEmpty(cellI.Value) Then Exit For

        Select Case cellI.Value
            Case Is >= 10
                With cellI.Font
                    .ColorIndex = 3 ' Rouge
                    .Bold = True
                End With
            Case 5 To 9
                cellI.Font.Underline = xlUnderlineStyleSingle ' Soulignement
            Case 1 To 4
                cellI.Font.Size = 18 ' Taille de police
            Case 0
                cellI.Font.ColorIndex = 2 ' Vert
        End Select
    Next cellI
    Application.ScreenUpdating = True
End Sub

Merci beaucoup, Joco.

J'ai testé, ça m'affiche "variable non définie" pour xlUnderlineSingle, je l'ai remplacé par xlUnderlineStyleSingle, cette fois-ci la macro fonctionne, mais il faut que je sélectionne les cellules une par une.

Bonjour

Tu peux joindre un exemple de ton fichier anonymisé

Crdlt

pas besoin d'envoyer le fichier, parce que maintenant, ça fonctionne, mais j'ai du sélectionner les cellules une par une (comme c'est la cellule active à chaque fois)

Merci Saboh, j'ai essayé ta méthode, ça m'affiche "membre de méthode ou de donnée introuvable" pour .cellls

fred62200 a écrit :

Merci Saboh, j'ai essayé ta méthode, ça m'affiche "membre de méthode ou de donnée introuvable" pour .cellls

Déso, j'ai MAJ mon message j'avais fait un mauvais rechercher/remplacer. C'est corrigé normalement.

Merci Saboh !

ça fonctionne :)

Content d'aider, n'oublie pas de passer le sujet en résolu.

Bonne fin de journée.

Bonne fn de journée à toi aussi.