Gestionnaire de format conditionnel en vba

[l0renz0]

Bonjour à tous,

J'ai passé un moment à chercher sans succés aussi bien anglais qu'en français.
Tout ceux qui utilisent les formats conditionnels connaissent le soucis: dés qu'on rajoute une ligne, on duplique les regles conditionnelles appliqués à la ligne initiale.
Et à la fin, on fait exploser notre ficher.
Je me disais qu'on pouvait créer une feuille particulière avec en cellule 1, le format qu'on veut appliquer, en cellule 2, le range sur lequel on veut l'appliquer (on passe uniquement par des zones nommées), en cellule 3 , la formule qu'on veut appliquer et ce pour chaque format conditionnel qu'on veut gerer.
Ensuite, a chaque fois qu'on ajoute des lignes. On supprime toutes les formats conditionnels et on les recréer à partir de cette feuille particulière via une macro vba.
Auriez-vous vu passer une macro de ce type ?

En vous remerciant d'avance de votre retour.

Laurent

 

[Dranreb]

Bonsoir.
J'ai ce code dans un de mes classeurs. Peut être pourrez vous vous en inspirer

Option Explicit
Sub RéinstallerMeFC()
   Dim RngSvgSel As Range, Wsh As Worksheet, Rng As Range, RngCol As Range
   With Application: .EnableEvents = False: .Calculation = xlCalculationManual
      .ScreenUpdating = False: End With
   Set RngSvgSel = Selection
   For Each Wsh In ThisWorkbook.Worksheets
      If Not Wsh.CodeName Like "WshDoc*" Then
         Set Rng = Wsh.ListObjects(1).Range
         Set Rng = Rng.Rows(2).Resize(Rng.Rows.Count - 1)
         Rng.FormatConditions.Delete
         Application.GoTo Wsh.Cells(1, 1)
         Set RngCol = Intersect(Wsh.[B:L], Rng)
         With MeFCR1C1(RngCol, "=AND(RC3<0,RC4=0)")
            .NumberFormat = ";;;"
            .Interior.Color = &HBABABA
            With .Borders(xlTop): .LineStyle = xlContinuous: .Color = &HE0E0E0: End With
            With .Borders(xlBottom): .LineStyle = xlContinuous: .Color = &HA9A9A9: End With
            .Borders(xlRight).LineStyle = xlLineStyleNone
            .Borders(xlLeft).LineStyle = xlLineStyleNone: End With
         Set RngCol = Intersect(Wsh.[C:C], Rng)
         With MeFCR1C1(RngCol, "=RC4=0")
            .Font.Color = &HA3A3A3: End With
         RngCol.NumberFormat = "0.0??\ "
         With MeFCR1C1(RngCol, "=ROUND(RC*1000,0)=ROUND(RC,0)*1000")
            .NumberFormat = "0_._0_0_0\ ": End With
         Set RngCol = Intersect(Wsh.[E:F], Rng)
         RngCol.NumberFormat = "0.0 "
         With MeFCR1C1(RngCol, "=ROUND(RC*10,0)=ROUND(RC,0)*10")
            .NumberFormat = "0_._0 ": End With
         With MeFCR1C1(Intersect(Wsh.[M:M], Rng), "=RC=""""")
            .Interior.Color = &HBABABA:: End With
         End If: Next Wsh
   With Application: .GoTo RngSvgSel: .EnableEvents = True
      .Calculation = xlCalculationAutomatic: End With
   End Sub
Private Function MeFCR1C1(ByVal Rng As Range, ByVal Formule As String) As FormatCondition
   With ActiveSheet.Names.Add(Name:="NomTemporairePourMeFC", RefersToR1C1:=Formule)
      Application.GoTo Rng(1, 1)
      Set MeFCR1C1 = Rng.FormatConditions.Add(Type:=xlExpression, Formula1:=.RefersToLocal)
      .Delete: End With
   MeFCR1C1.StopIfTrue = False
   End Function

 

[l0renz0]

Merci !
J'ai l'impression que ça efface tous les formats conditionnels et ça les recreer ensuite.
Je vais voir ce que je peux faire.
Dommage que ces formats conditionnels soient si mal gérés dans excel, c'est tellement bien sinon.

 

[l0renz0]

J'ai un peu progressé ... Je sais maintenant creer des formats conditionnels sur des zones nommées a partir de cellules portant la mise en forme de ces formats conditionnels. Par contre je souffre enormement pour mettre en place des mises en forme un peu plus complexe, notamment des gradients de couleur. Je pensais betement qu'il me suffisait de recuperer les attributs de la cellule et de les recopier dans mon format conditionnel mais que nenni !!!
La mise en forme d'une cellule c'est compliqué
Ca a commençé à se gater avec themecolor ...
Si quelqu'un a un bout de code pour recuperer l'ensemble des caracteristiques d'une cellule, ça m'interesse !

En vous remerciant d'avance

LAURENT

 

[l0renz0]

Bon je vais essayer de simplifier l'affaire ...
Je mets tous mes formats conditionnels dans une feuille cachée ainsi que la feuille et la zone d'application et la formule a considerer par format conditionnel dans des cellules adjacentes.
J'efface tous les formats conditionels des feuilles listées dans cette feuille cachée.
Je recopie les formats conditionnels dans les feuilles ou ils doivent etre appliqués
J'applique la formule ainsi que la zone a considerer a chacun des formats conditionnels.
Et voili
Bon c'est pas encore fait mais ça devrait marcher.
Je peux ensuite allegrement ajouter des lignes ou des colonnes et lorsque ma feuille est trop lourde acause des formats conditionnels, lancer ma macro.
Si vous avez une meilleure piste, ça m'interesse !

 

[l0renz0]

Bizarre quand meme que personne n'ai tordu le cou à ce probleme.
Aprés pas mal d'heures de recherche, j'ai finalement développé ce qui est indiqué au dessus.
Je transmets un fichier d'exemple dés qu'il est propre.

 

[l0renz0]

Voili

 

[l0renz0]

Public Function WorkSheetExist(Sheetname As String) As Boolean

Dim Sh As Variant

On Error Resume Next
WorkSheetExist = False
For Each Sh In Worksheets
  If Sh.Name = Sheetname Then WorkSheetExist = True
Next

End Function

Sub arrayBuilder()

Dim i As Integer, j As Integer
Dim nb_lig As Integer, nb_cf As Integer
Dim cf_range As String
Dim formula As String

Const WORKING_AREA As String = "working_area_cf"

Dim ActiveR As Range
Dim ActiveS As Worksheet
   
Set ActiveS = ActiveSheet
Set ActiveR = ActiveCell

'create a sheet as working are
If WorkSheetExist(WORKING_AREA) Then
  Application.DisplayAlerts = False
  Sheets(WORKING_AREA).Delete
  Application.DisplayAlerts = True
End If
With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = WORKING_AREA
End With

'copy all cf to set in working area (conditional formats shall be in a named area called cf)
ActiveS.Activate

Range("cf").Copy
   
Sheets(WORKING_AREA).Select
Range("A1").Select
ActiveSheet.Paste

ActiveS.Activate
Application.CutCopyMode = False

'delete all conditions
Cells.FormatConditions.Delete

'copy all cf from working area to active workesheet
Sheets(WORKING_AREA).Select
Selection.Copy
   
ActiveS.Activate
Application.Goto Reference:="cf"
ActiveSheet.Paste

Application.DisplayAlerts = False
Sheets(WORKING_AREA).Delete
Application.DisplayAlerts = True

' count number of cf to set (stop to first cell empty in idx column
nb_lig = Range("cf").Rows.Count
For nb_cf = 1 To nb_lig
     If IsEmpty(Range("cf").Item(nb_cf, 1)) Then Exit For
Next nb_cf
nb_cf = nb_cf - 1

' set all cf in the worksheet
For i = 1 To nb_cf
    cf_range = Range("cf").Item(i, 3).Value & "," & Range("cf").Item(i, 2).Address

    Range("cf").Item(i, 2).FormatConditions(1).StopIfTrue = Range("cf").Item(i, 5).Value

    Range("cf").Item(i, 2).FormatConditions(1).ModifyAppliesToRange Range(cf_range)
   
    If Not (IsEmpty(Range("cf").Item(i, 4))) Then
      Range(cf_range).FormatConditions(1).Modify xlExpression, Formula1:=Range("cf").Item(i, 4).Value
    End If
   
    Range(cf_range).FormatConditions(Range(cf_range).FormatConditions.Count).StopIfTrue = Range("cf").Item(i, 5).Value

Next i
   
Application.CutCopyMode = False
ActiveR.Activate

End Sub

 

[l0renz0]

ça peut eventuellement servir, voici la premiere partie de l'exercice qui permet de lister les formats conditionnels avant de le rzappliquer de façon propre