Format van grafieken wordt niet opgeslagen

[CBastion]

Beste forumleden,

Ik heb een aantal grafieken van hetzelfde type en om deze te onderscheiden elk andere kleurpatronen gegeven. Echter, elke keer als ik het bestand kopieer en opnieuw gebruik voor de opvolgende maand, worden van 4 van de 10 grafieken de opmaak instellingen teruggezet op automatisch. Waarom dit niet bij de andere 6 gebeurd is mij een raadsel. Deze 6 behouden wel hun opmaak. Ik heb de instellingen vergeleken met de grafieken die wel het juiste kleurpatroon behouden, maar alles is hetzelfde. Is dit een bug? Heeft iemand hier eerder problemen mee gehad?

Met vriendelijke groet,

...

 

[AHulpje]

Nee, nooit problemen mee gehad.
Plaats je document eens hier.

 

[CBastion]

Onderstaand het bestand. Het gekke is dus dat nu nog maar één grafiek zijn opmaak behoud. Alle anderen zijn weer automatisch door Excel aangepast.

 

[AHulpje]

Hoogst waarschijnlijk heb je direct na het aanpassen van de achtergrondkleuren van de grafieken de knoppen Show en Hide gebruikt. Als je direct na het wijzigen van de kleuren eerst het document opslaat blijven de ingestelde kleuren behouden.

Overigens lijkt mij het gebruik van 371 voorwaardelijke opmaak regels ietwat overdreven en niet erg onderhoudsvriendelijk, dat is zeer sterk te reduceren door wat handiger gebruik te maken van de opgegeven ranges.

Verder heb ik je broncode wat opgeschoond, o.a. vier keer dezelfde Subroutinenaam in vier modules is niet echt handig.

 

[cow18]

hello,
als je even maakt dat alle regels kwa voorwaardelijke opmaak netjes in rij 4 staan, dan wis je de rest en kopieer je die van rij 4 en plak je die "als opmaak" over de rest.
Maar zo op het eerste zicht is die rij 4 nog niet helemaal up to date

Sub CF()
     With Sheets("Data Processing")
          .Range("5:90").FormatConditions.Delete
          .Range("A4:AX4").Copy
          .Range("A5:A45").PasteSpecial xlFormats
          .Range("A49:A90").PasteSpecial xlFormats
     End With
End Sub

 

[AHulpje]

Hiermee maak je een rapportje van de voorwaardelijke opmaakregels van alle werkbladen.

Sub List_Conditional_Formatting_Rules()
    Dim ws As Worksheet, wsOpmaak As Worksheet, r As Long
    Dim CFrule As FormatCondition, Rng As Range
    
    On Error Resume Next
    If Not sheetExists("Opmaak") Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Opmaak"
    Else
        Sheets("Opmaak").Cells.ClearContents
    End If
    Set wsOpmaak = Sheets("Opmaak")
    wsOpmaak.Range("A1:G1").Value = [{"Sheet","Operator","Formula1","Formula2","Range","ColorIndex","Colour"}]
    r = 2
    For Each ws In Worksheets
        If ws.Name <> "Opmaak" Then
            Set Rng = ws.Cells
            For Each CFrule In Rng.FormatConditions
                Select Case CFrule.Operator
                    Case 1
                        op = "tussen"
                    Case 3
                        op = "="
                    Case 5
                        op = ">"
                    Case 6
                        op = "<"
                    Case Else
                        op = CFrule.Operator
                End Select
                With wsOpmaak.Rows(r)
                    .Cells(1) = ws.Name
                    .Cells(2) = op
                    .Cells(3) = CSng(Replace(CFrule.Formula1, "=", ""))
                    .Cells(4) = CSng(Replace(CFrule.Formula2, "=", ""))
                    .Cells(5) = CFrule.AppliesTo.Address
                    .Cells(6) = CFrule.Interior.ColorIndex
                    .Cells(7).Interior.ColorIndex = CFrule.Interior.ColorIndex
                End With
                r = r + 1
            Next CFrule
        End If
    Next ws
    Cells.AutoFilter
    wsOpmaak.Columns.AutoFit
    ActiveWindow.SplitRow = 1
    ActiveWindow.FreezePanes = True
End Sub

Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function