Macro VBA mise en surbrillance plage total

Bonjour,

Je souhaiterais mettre en place une macro qui me met en couleur de remplissage les sous-totaux une plage de cellules

Cas concret en PJ

Je ne maîtrise pas les conditions en VBA...

Merci pour votre aide

Joris

Salut j.winkler,

pas besoin de VBA : une MFC sera plus efficace!

Si, si : c'est moi qui l'ai dit!

• sélectionne les colonnes [A:H]
• ACCUEIL -> Mise en forme conditionnelle -> Nouvelle règle -> Utiliser une formule (ci-dessous) -> Format

=GAUCHE($A1;5)="Total"

A+

Bonjour,

A tester :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String

    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    Set Cel = Plage.Find("Total", , xlValues, xlPart)

    If Not Cel Is Nothing Then

        Adr = Cel.Address

        Do

            Cel.Font.Bold = True
            Set Cel = Plage.FindNext(Cel)

        Loop While Cel.Address <> Adr

    End If

End Sub

Bonjour

Bonjour à tous

Une variante.

Bye !

curulis57 a écrit :

Salut j.winkler,

pas besoin de VBA : une MFC sera plus efficace!

Si, si : c'est moi qui l'ai dit!

• sélectionne les colonnes [A:H]
• ACCUEIL -> Mise en forme conditionnelle -> Nouvelle règle -> Utiliser une formule (ci-dessous) -> Format

=GAUCHE($A1;5)="Total"

A+

Salut Curulis57,

Merci pour ta contribution, je n´avais pensé à une MFC avec recherche d´occurence, merci pour le tuyau

Joris

Theze a écrit :

Bonjour,

A tester :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String

    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    Set Cel = Plage.Find("Total", , xlValues, xlPart)

    If Not Cel Is Nothing Then

        Adr = Cel.Address

        Do

            Cel.Font.Bold = True
            Set Cel = Plage.FindNext(Cel)

        Loop While Cel.Address <> Adr

    End If

End Sub

Salut Theze,

Merci pour ta contribution, malheureusement ça ne marche pas.....

gmb a écrit :

Bonjour

Bonjour à tous

Une variante.

Bye !

Salut gmb,

Ça marche nickel par contre je me suis peut-être mal exprimé sur le résultat attendu.

Je ne souhaitais pas déplacer les lignes totaux vers la droite, je voulais simplement un remplissage couleur de la ligne total, une mise en gras des éléments et maintenir la formule sous.total.

Pourrais-tu modifier la macro dans ce sens ? Ce serait super sympa à toi

Merci beaucoup!

Joris

Bonjour,

Désolé, j'avais juste fais une mise en gras sur la première colonne donc, voici le code corrigé :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String

    With Worksheets("Feuil1")
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

        Set Cel = Plage.Find("Total", , xlValues, xlPart)

        If Not Cel Is Nothing Then

            Adr = Cel.Address

            Do

                .Range(Cel, Cel.Offset(, 7)).Font.Bold = True
                .Range(Cel, Cel.Offset(, 7)).Interior.Color = 15652540

                Set Cel = Plage.FindNext(Cel)

            Loop While Cel.Address <> Adr

        End If

    End With

End Sub

Theze a écrit :

Bonjour,

Désolé, j'avais juste fais une mise en gras sur la première colonne donc, voici le code corrigé :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String

    With Worksheets("Feuil1")
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

        Set Cel = Plage.Find("Total", , xlValues, xlPart)

        If Not Cel Is Nothing Then

            Adr = Cel.Address

            Do

                .Range(Cel, Cel.Offset(, 7)).Font.Bold = True
                .Range(Cel, Cel.Offset(, 7)).Interior.Color = 15652540

                Set Cel = Plage.FindNext(Cel)

            Loop While Cel.Address <> Adr

        End If

    End With

End Sub

C´est exactement ça, merci beaucoup