Macro formatage conditionnel tableau

Bonjour,

Je crois que ce que je veux faire est relativement simple mais j'ai du mal avec les macros "tableaux"...

J'ai créé un tableau tout bête. Je souhaiterais que l'on choisi de cocher "X" dans n'importe quelle ligne de la colonne B, la ligne correspondante se grise avec un motif.

Je mets le fichier test en pièce jointe. Merci de votre aide :)

Bonjour,

Essayez ceci

Cdlt

Merci !

Par contre cela ne prend pas du tout en compte le range du tableau. Ce tableau est voué a être variable en nombre de ligne. J'imaginais plutôt qu'on puisse définir la macro pour le tableau en lui-même, qu'il fasse 2 ou 15 lignes. Je ne sais pas si c'est compréhensible...

Alors ceci:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = False
    DerLig = Range("A2").End(xlDown).Row
    If Not Intersect(Target, Range("B2:B" & DerLig)) Is Nothing Then
        If Target.Value = "X" Then
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 14
        Else
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 0
        End If
    End If
Sortie:
    Application.EnableEvents = True
End Sub

En emplacement de l'autre code(dans le module de la feuille)

Bonjour,

Merci beaucoup pour votre aide ! Je suis désolé mais je ne vois pas l'appel du tableau (15 en l'occurrence). J'ai une macro qui permet de descendre les lignes par exemple, voici le code :

Sub Descendre()
 '--- Always UNPROTECT before VBA ---
        ActiveSheet.Unprotect
'Descendre les lignes de la s_lection en dessous de la ligne situ_e en-dessous
       If (ActiveCell.Row = Range("Tableau3").Rows.Count + 2) Then
        MsgBox "Vous êtes arrivés en bas."
        ElseIf ActiveCell.Row = 2 Then
        MsgBox "On ne peut pas descendre l'entête !"

    Else

        With [Tableau3].ListObject.DataBodyRange
        y = Selection.Row - .Row + 1
        Nbl = Selection.Rows.Count
        NbC = .Columns.Count
        .Range(Cells(y, 1), Cells(y + Nbl - 1, NbC)).Cut
        .Rows(y + Nbl + 1).Insert Shift:=xlDown
        .Rows(y + Nbl).Locked = False
        .Rows(y + Nbl).Select
    End With

        End If
            '--- Always PROTECT after VBA ---
        ActiveSheet.Protect AllowFiltering:=True, AllowSorting:=True
End Sub

Le fait est que mon fichier comporte plusieurs onglets avec plusieurs tableau différents et que chaque tableau est bien voué à bouger selon le contexte.

Bonjour,

Alors ceci:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Tabl As String
    Dim Sh As Worksheet
    On Error GoTo Sortie
    Application.EnableEvents = False
    Set Sh = Sheets(ActiveSheet.Name)
    Tabl = Sh.ListObjects(1).Name 'prend le nom du tableau sélectionné
    If Not Intersect(Target, Range(Tabl)) Is Nothing Then
        If Target.Value = "X" Then
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 14
        Else
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 0
        End If
    End If
Sortie:
    Application.EnableEvents = True
    Set Sh = Nothing
End Sub

Cdlt

Bonjour,

Je m'excuse d'avance :) Décidément je n'arrive pas à faire ce que je voudrais. J'ai donc un fichier excel avec plusieurs onglets dans lesquels il y'a plusieurs tableaux.

Dans chaque tableau il y'a une colonne dans laquelle on peut mettre la valeur X (avec une liste déroulante). Ce que je voudrais c'est que lorsque cette case comporte la valeur X, la ligne entière du tableau se grise. Voici ci-dessous une macro qui me permet de descendre les lignes d'un tableau, j'imagine une macro similaire pour ce formatage de ligne :

Sub Check_ligne()
 '--- Always UNPROTECT before VBA ---
        ActiveSheet.Unprotect

 If Target.Value = "X" Then
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 14
        Else
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 0
        End If
End Sub

Comment faire pour dire que "Target.Value" fait référence à n'importe quelle cellule de la 2ème colonne du Tableau15 par exemple ?

Cela me permettrait d'adapter cette macro pour n'importe quel tableau de ma feuille excel.

Je ne comprends pas bien le code d'Arturo ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Tabl As String
    Dim Sh As Worksheet
    On Error GoTo Sortie
    Application.EnableEvents = False
    Set Sh = Sheets(ActiveSheet.Name)
    Tabl = Sh.ListObjects.Name = Tableau15
    If Not Intersect(Target, Range(Tabl)) Is Nothing Then
        If Target.Value = "X" Then
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 14
        Else
            Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).Interior.Pattern = 0
        End If
    End If
Sortie:
    Application.EnableEvents = True
    Set Sh = Nothing
End Sub

Ne peut-on pas appeler tel ou tel tableau en faisant référence à une colonne bien précise ? Le code me parait compliqué ?

Merci de votre aide.

Bonjour,

"j'ai donc un fichier excel avec plusieurs onglets dans lesquels il y'a plusieurs tableaux.", ça c'est nouveau.

Supprimez le code précédent et collez le nouveau code ci-dessous dans le module du classeur "ThisWorkbook",

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tabl As String
    On Error GoTo Sortie
    Application.EnableEvents = False
    Set Sh = Sheets(ActiveSheet.Name)
    Tabl = Sh.ListObjects(1).Name 'prend le nom du tableau sélectionné
    If Not Intersect(Target, Range(Tabl)) Is Nothing Then
        If Target.Value = "X" Then
            Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Interior.Pattern = 14
        Else
            Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Interior.Pattern = 0
        End If
    End If
Sortie:
    Application.EnableEvents = True
    Set Sh = Nothing
End Sub

Le fonctionnement correspond bien à ce que vous demandez, toute sélection d'un "X" dans la 2ème colonne du tableau , grise immédiatement la ligne entière de ce tableau; l'effacement du "X" supprime le motif de la ligne.

Cdlt

Bonjour,

Cela fonctionne parfaitement, il fallait mettre le code dans "Microsoft Excel Objects / ThisWorkbook.

Vous allez me détester :-)

Sur les autres onglets, les tableaux ne font pas tous la même taille. Actuellement le code fait appel au tableau sélectionné, je trouve le principe très bien. Au lieu de choisir de griser la ligne de telle à telle colonne, ne peut-on pas griser la ligne entière du tableau ? Quelque soit sa taille ?

Tabl = Sh.ListObjects(1).Name 'prend le nom du tableau sélectionné    

    With [Tabl].ListObject.DataBodyRange
        y = Selection.Row
 ?

Cela fonctionne parfaitement, il fallait mettre le code dans "Microsoft Excel Objects / ThisWorkbook. Oui mais c'est légèrement différent

Si vous voulez griser la ligne entière, remplacez :

Range(Cells(Target.Row, "A"), Cells(Target.Row, "C"))

par

Rows(Target.Row)

On y est presque :-)

Là effectivement ça grise toute la ligne. Ce que je souhaiterais c'est griser la ligne du tableau.

Je crois que j'ai réussi... Je veux bien une affirmation de votre part mais visiblement ça fonctionne :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tabl As String
    On Error GoTo Sortie
    Application.EnableEvents = False
    Set Sh = Sheets(ActiveSheet.Name)
    Tabl = Sh.ListObjects(1).Name 'prend le nom du tableau sélectionné
    ' derniere colonne non vide ligne 1
    lastCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
    If Not Intersect(Target, Range(Tabl)) Is Nothing Then
        If Target.Value = "X" Then
            Range(Cells(Target.Row, "A"), Cells(Target.Row, lastCol)).Interior.Pattern = 14

        Else
            Range(Cells(Target.Row, "A"), Cells(Target.Row, lastCol)).Interior.Pattern = 0

        End If
    End If
Sortie:
    Application.EnableEvents = True
    Set Sh = Nothing
End Sub

Il reste une dernière subtilité.

Le code

    Tabl = Sh.ListObjects(1).Name 'prend le nom du tableau sélectionné

me renvoie donc le premier tableau de la feuille. Il se trouve qu'il y'a un onglet dans lequel plusieurs tableaux se succèdent. Cela fonctionne pour le premier tableau. Bien sur je peux changer Sh.ListObjects(1) avec 2 ou 3. Mais comment faire pour que cela puisse prendre en compte l'ensemble des tableaux de l'onglet ?

Cordialement

Bonjour,

Avec le fichier je comprends mieux, le problème chez moi , c'est qu'à chaque la macro s'applique, le tableau se rassemble sur une même feuille, voir l'image ci-dessous:

sinon le code suivant fonctionne bien

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tabl As String
    Dim LastCol As Long, Col_Received As Long
    On Error GoTo Sortie
    Application.EnableEvents = False
    Set Sh = Sheets(ActiveSheet.Name)
    Tabl = Sh.ListObjects(1).Name 'prend le nom du tableau sélectionné
    LastCol = Sh.ListObjects(Tabl).DataBodyRange.Columns.Count 'Derniere colonne du tableau
    Col_Received = Sh.ListObjects(Tabl).HeaderRowRange.Find("Received (Y/G)", LookAt:=xlWhole).Column
    If Not Intersect(Target, Columns(Col_Received)) Is Nothing Then
        If Target.Value = "X" Then
            Range(Cells(Target.Row, "A"), Cells(Target.Row, LastCol)).Interior.Pattern = 14
        Else
            Range(Cells(Target.Row, "A"), Cells(Target.Row, LastCol)).Interior.Pattern = 0
        End If
    End If
Sortie:
    Application.EnableEvents = True
    Set Sh = Nothing
End Sub

Cdlt

bonjour Arturo83, Long Noze, le fil,

n'avez vous pas pensé a un MFC et y-a-t-il déjà d'autres MFCs dans ces tableaux ?

Dans ce cas, on n'a qu'à mettre à jour les MFCs existants dans tous/certains tableaux.

re,

par exemple RAZ les mfcs existants et ajoutez un nouveau

Sub MFC()
     For Each lo In ActiveSheet.ListObjects 'boucle les tableaux existants
          With lo.DataBodyRange ' le body
               If .Rows.Count Then 'y-a-t-il des lignes ?
                    MsgBox Name & vbLf & .Address, vbInformation, "Mon Tableau"
                    .Cells.FormatConditions.Delete 'RAZ les MFCs

                    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1, 2).Address(0, 1) & "=""x""" 'ajoutez celui-ci
                    .FormatConditions(1).SetFirstPriority
                    .FormatConditions(1).Interior.Color = 5296274 'changez le couleur ou d'autres formats ...

               End If
          End With
     Next
End Sub

Arturo83,

Ah oui c'est peut-être un problème de version excel ? Si cela fonctionne chez vous ? Effectivement chez moi ce sont 3 tableaux bien séparés.

Le dernier code fonctionne effectivement bien mais donc uniquement sur cet onglet ^^En effet sur les autres, la colonne recevant la valeur X ne s'appelle pas forcement "Received (Y/G)".

Sur la premiere page "program" il n'y a tout simplement pas de titre de colonne et sur les autres onglets ça s'appelle "Done (Y/G)". Par contre c'est toujours la colonne B ou C, peut-être est-ce une piste ?