Zkopírování hodnot barev a nastavení barev grafu – Visual Basic – Fórum – Programujte.com

Kdysi jsem zkoušel napsat takový kód, ale bylo to pro Office XP.

Zase jsem narazil na nedodělaný kód, který by se mi hodil. První část funguje.

Vyberu graf a do sešitu "t" zkopíruji hodnoty, které později budu chtít nastavit na další grafy.

Předpoklad je že grafy mají stejný formát dat (počet řad sloupců).

Sub vyextrahuj_styly_grafu()
    Dim it As ChartObject, j As Integer, i As Integer, R As Integer, wsT As Worksheet
    
    Set wsT = Sheets("t")
    If TypeName(Selection) <> "ChartArea" Then
       MsgBox "Please select ChartArea, not" + TypeName(Selection)
    Exit Sub
    End If
    
    For j = 1 To ActiveChart.SeriesCollection.Count
        R = R + 1
        With ActiveChart.SeriesCollection(j)
            wsT.Cells(R, 1) = .Fill.ForeColor.RGB
            wsT.Cells(R, 2) = .MarkerStyle
            wsT.Cells(R, 3) = .MarkerSize
            wsT.Cells(R, 4) = .MarkerForegroundColor
        End With
    Next
End Sub

Vygenerované data v sešitu t:

10077403	-4142	5	58
10077403	-4142	5	58
10077403	-4142	7	58
10077403	-4142	5	58
10077403	-4142	5	58
0	-4105	5	57
10077403	9	5	10
10077403	-4142	5	58
10077403	-4142	5	58
10077403	-4142	5	58
10077403	-4142	5	58
0	-4105	5	57
0	-4105	5	57
10077403	-4115	5	46

Následuje makro, které mělo podle této tabulky nastavit barvy a formátorvání čár vybraného grafu:

Sub nastav_styly_grafu_podle_tabulky()
'
' nastav_styly_grafu_podle_tabulky Makro
' zkratka ctrl+ě, (ctrl+plus e s hackem): přečti styly datových řad z tabulky a nastav je do vybraného grafu
'
' hotkey: Ctrl+ě
'
    Dim wsS As Worksheet, it As ChartObject, table As Range, c As Integer, l As Integer, ChartSheetName As String
    Dim R As Integer, G As Integer, B As Integer
    
    ChartSheetName = ActiveSheet.Name
    Set wsS = Sheets("t") ' Here is source table with Chart styles values
    Sheets("t").Activate
    Set table = wsS.Range("A1", Range("D11"))
    Sheets(ChartSheetName).Activate
    For l = 1 To table.Rows.Count
       With table.Rows(l).Columns
       For Each it In ActiveSheet.ChartObjects
         ' See https://exceloffthegrid.com/…color-codes/#Long
         ' Proc je tu l a ne 1? Call LongToRGB(.Cells(l).Value, R, G, B)
         Call LongToRGB(.Cells(l).Value, R, G, B)
        
        ' nejde nastavit barvu - run time error 1004 - because we have a limited number of columns in Excel. When our code gives the command to go out of range, we get a 1004 Error. There are other situations when we get this error when we refer to a range that does not exist in the sheet.
         it.Chart.SeriesCollection(l).Fill.Visible = msoFalse
         it.Chart.SeriesCollection(l).Fill.Visible = msoTrue
         it.Chart.SeriesCollection(l).Fill.ForeColor.RGB = RGB(R, G, B)
        
        ' error: nelze ziskat vlastnost Interior tridy series!
        '  it.Chart.SeriesCollection(l).Interior.Color.RGB = RGB(R, G, B)
          
          it.Chart.SeriesCollection(l).MarkerStyle = .Cells(2).Value
         it.Chart.SeriesCollection(l).MarkerSize = .Cells(3).Value
         it.Chart.SeriesCollection(l).MarkerForegroundColor = .Cells(4).Value
       Next it
       End With
    Next
End Sub

Chyby, které to hlásí viz komentáře. Barva čáry je na Office XP pod fill.forecolor oproti novějším verzím kde to je pod format... Takže v jednom místě mi to hlásí
run time error 1004
ale přitom ty další formáty které neobsahují RGB jdou zpřístupnit a nastavit bez problémů. Vlastnost fill.forecolor.RGB nejde zpřístupnit ani v kukátku. A zkoušel jsem nastavit
it.Chart.SeriesCollection(0) nebo
it.Chart.SeriesCollection(1), ale asi se to má iterovat od jedničky...

Nějaký nápad jak to rozjet?

 

ty seš v důchodu Oxidiáne ? seš důchodce ?

Ofice maji takovou skvelou vec, moznost zaznamenavat makra. Da se to pouzit na zjisteni, jak se v nich pise obarvovani car a jine veci. Mozna by to vyresilo ten problem s Interior. Kazdy excel ma bohuzel uplne jinaci kody pro makra :) Treba v tom mem nefunguje dochazkovy list, ktery posilaji z hlavniho pracoviste. Pise nejake neexistujici promene. A oni si to odmitaji spravit! Cimz mne pekne stvou!
 

Mozna par poznamek...

         ' Proc je tu l a ne 1? Call LongToRGB(.Cells(l).Value, R, G, B)
--> proto
-->     For l = 1 To table.Rows.Count
--> L je pocet radku tabulky?

--> tento zapis je to same jako...
       With table.Rows(l).Columns
         Call LongToRGB(.Cells(l).Value, R, G, B)
--> ... toto
         Call table.Rows(l).Columns.LongToRGB(.Cells(l).Value, R, G, B)
--> takze, asi jenom pro jednu funkci nema smysl pouzivat with
--> ale, mohl bys to pouzit pozdeji, na vsechy ty radky
--> it.Chart.SeriesCollection(l)

nebo, mozna je to takhle 

--> tento zapis je to same jako...
       With table.Rows(l).Columns
         Call LongToRGB(.Cells(l).Value, R, G, B)
--> ... toto
         Call LongToRGB(table.Rows(l).Columns.Cells(l).Value, R, G, B)

pak ta otazka asi ma smysl, a nevim. Nechce se mi to googlovat.

Mám problém, že jakmile si neudělám poznámky tj. komentáře, pak po čase zapomenu jak k´d fungoval. Takže tímto vyvracím Kitovo tvrzení o tom, že komentáře jsou jen tam kde je třeba něco dodělat, nebo kde je chyba.

No ale nevím jak chceš například nahrát makro typu: "Zjisti mi jaká barva je nastavená u řad, které se používají v tomto grafu..." Nebo: "Nastav barvu tohoto grafu podle předchozího grafu v tomto sešitě " ... případě alternativně:

"... podle téhož grafu v předchozím sešitě."

To makro když ho nahraješ bude vypadat úplně jinak, řekne ti jen jakou barvu máš nastavit. Programátor od přirozenosti hledá to nejjednodušší řešení. Asi jsem to makro už jednou zaznamenal a nastavil ty barvy u grafů, apak jsem to zapomněl ve kterém to bylo grafu nebo jsem ho smazal. A teď jsem našel jeden graf, který jsem přeskočil. A jsem u kořene problému. Zas bych musel dělat znova to co jsem mohl už mít hotové, kdybych tomu problému rozuměl. Bohužel jak říkáš, je tolik verzí toho programu a není kdo by měl stejnou verzi.

Co bys tady do toho komentáře napsal? Že Interior je vnitřek a Color je barva?