Macro pour créer des MFC paramétrables
Bonjour,
J'ai écrit une macro pour créer des MFC pour mettre en couleur un tableau. J'ai créé une macro car :
- je veux pouvoir changer les couleurs dans un onglet de mise en forme sans changer la macro
- cette macro va me servir pour plusieurs fichiers et les conditions ne sont pas dans les mêmes colonnes
- comme je rajoute des lignes dans le tableau en faisant des copier-coller, les MFC ont tendance à se multiplier comme des petits pains et après c'est un peu le fouillis dans la liste des MFC. La macro me permet de remettre que celles que je veux.
Donc j'ai créé un onglet 'Mise en forme' où je mets les couleurs et les colonnes concernées pour chaque condition dans des cellules que j'ai nommées individuellement et ensuite j'ai fait une macro qui crée les conditions en récupérant la couleur et la colonne concernée pour construire la formule à utiliser (expression)
Cela fonctionne bien mais je voudrais aller plus loin, je voudrais mettre la formule complète dans l'onglet de Mise en Forme et là je n'y arrive pas, j'ai une erreur d'affectation. Pourtant quand je regarde avec un espion la valeur de ma variable, cela me semble correct. Je pense qu'il s'agit d'une histoire de double guillemet mais j'ai essayé plein de choses et ou j'ai une erreur ou la colorisation ne fonctionne pas.
Dans le fichier ci-joint le Cas No 1 est celui qui fonctionne, le Cas no 2 est celui que j'aimerais faire fonctionner. Par défaut, le fichier a été enregistré pour le cas No1.
Merci beaucoup à ceux qui voudront bien se pencher sur mon problème.
bonjour,
concernant le problème des petits pains, j'avais une macro qui pouvait règler cela (Google is your best friend)
Sub FixCondFormatDupRules()
'
Dim ws As Worksheet
Dim MyList As ListObject
Dim lRows As Long
Dim rngData As Range
Dim rngRow1 As Range
Dim rngRow2 As Range
Dim rngRowLast As Range
Set ws = ActiveSheet
Set MyList = ws.ListObjects(1) 'Note this only captures the first table in the ActiveSheet. Wouldn't work if >1 table.
Set rngData = MyList.DataBodyRange
lRows = rngData.Rows.Count
Set rngRow1 = rngData.Rows(1)
Set rngRow2 = rngData.Rows(2)
Set rngRowLast = rngData.Rows(lRows)
With ws.Range(rngRow2, rngRowLast)
.FormatConditions.Delete
End With
' Expanding the Conditional Formatting AppliesTo range to the extent of the ranges and to include the entire table column.
For Each col In rngRow1.Columns
For Each fc In Range(col.Address).FormatConditions
Set FirstCell = col 'Find upper-left cell (lowest row, lowest col)
Set LastCell = Cells(rngRowLast.Row, col.Column) 'Find lower-right cell (highest row, highest col)
For Each xCell In fc.AppliesTo.Cells
If xCell.Column < FirstCell.Column Then Set FirstCell = Cells(FirstCell.Row, xCell.Column)
If xCell.Column > LastCell.Column Then Set LastCell = Cells(LastCell.Row, xCell.Column)
If xCell.Row < FirstCell.Row Then Set FirstCell = Cells(xCell.Row, FirstCell.Column)
If xCell.Row > LastCell.Row Then Set LastCell = Cells(xCell.Row, LastCell.Column)
Next xCell
fc.ModifyAppliesToRange Range(FirstCell, LastCell)
Next fc
Next col
rngRow1.Cells(1, 1).Select
Application.CutCopyMode = False
End SubBonjour,
Merci BsAlv pour ta solution concernant la multiplication des petits pains : je vais regarder cela attentivement.
Mais cela m’intéresse aussi de voir si quelqu'un a une solution pour résoudre mon problème de conditions paramétrables.Parce qu'après avoir cherché dans tous les sens, je sèche un peu ...
Bonne journée à tous
je ne comprend pas cas 1 et cas 2
les MFC sont maintenant déjà dans un boucle et la plage ne doit pas se trouver en A1
Sub Creer_MFC_2()
Set c = Range("TBL_MFC").ListObject.DataBodyRange 'plage avec les MFC
With Range("TBL_Données").ListObject.Range
.Cells.FormatConditions.Delete 'effeacer tout les MFC
For r = c.Rows.Count To 1 Step -1 'boucle les MFC
sp = Split(c(r, 3), ";") '3ième colonne = ligne & colonne, sont ils absolute (=1) ou relatif (=0) ? exemple >>> "0;1" veut dire ligne=relatif et colonne=absolute
If UBound(sp) = 1 Then
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=" & .Range(Replace(c(r, 2).Value, "$", "")).Address(sp(0), sp(1)) & "=""" & c(r, 7).Value & """") 'ajouter
.Interior.Color = c(r, 2).Interior.Color
.StopIfTrue = True
End With
End If
Next
end with
end subOui c'est un peu compliqué à expliquer par écrit. Cas 1 = cas qui fonctionne, cas 2 = cas qui ne fonctionne pas.
Je passe du cas 1 au cas 2 en recopiant manuellement par copier.coller les valeurs des colonnes Cas x (D4:D7 ou F4:F7) vers B4:B7 et je re-exécute la macro
Merci pour ton exemple :
Je n'avais pas pensé à faire une boucle pour ajouter les MFC : très bonne idée.
Je vais m'inspirer aussi de ta façon de construire la formule conditionnelle avec 2 paramètres : 1 pour la colonne et 1 pour la valeur.
Je vais retenir cette solution et l'appliquer à mon fichier.
Pourquoi dis-tu que la plage ne doit pas se trouver en A1 ? Il s'agit du tableau des données à coloriser ?
En tous cas mille merci pour cette solution qui m'ouvre plein d'autres possibilités.
re,
ces MFC sont difficile à bien definir les addresses
j'ai déplacé la plage "TAB_Donnees" vers E9:J17 et si j'utilise votre macro maintenant, il utilise les cellules originales $C1 et $B1, donc faux.
La mienne, elle fonctionne relatif à la cellule "topleft" du tableau, maintenant E9, si vous déplacer de nouveau cette plage il ne faut plus corriger. par exemple C1 relatif à E9 = G9
Puis je ne savais pas comment faire pour que l'adresse de ces cellules soit absolut ou relatif pour les lignes et colonnes, c'est la 3ième colonne "l;c" avec l et c =0 (relatif) ou 1 (absolut).
Vous utilisez toute la plage "TAB_Donnees" inclu les entêtes, donc j'avais utilisé aussi le range du tableau >> With Range("TBL_Données").ListObject.Range
Vous pouvez modifier cela en With Range("TBL_Données").ListObject.DatabodyRange = le tableau sauf les entêtes
Voici le code que j'ai adapté à mon exemple (merci BsAlv pour la macro) :
'--------------------------
Sub CreerMFC()
' Macro adaptée de l'exemple de BsAlv (forum.excel-pratique.com)
Set c = Range("TAB_MFC").ListObject.DataBodyRange 'plage avec les MFC
With Range("TAB_Donnees").ListObject.Range
.Cells.FormatConditions.Delete 'effacer toutes les MFC
For r = c.Rows.Count To 1 Step -1 'boucle sur les MFC
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=" & c(r, 2).Value & "=""" & c(r, 3).Value & """")
.Interior.Color = c(r, 2).Interior.Color
.StopIfTrue = True
End With
Next
End With
End Sub
'--------------------------J'ai repris l’idée de la boucle (beaucoup plus simple
Cela fonctionne nickel !
Je mets le fichier modifié en PJ
Merci encore au forum et aux personnes qui prennent de leur temps pour aider.
mais avec la restriction que la plage à colorer doit commencer a A1.