Zkopírování hodnot barev a nastavení barev grafu – Visual Basic – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu

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

 

oxidián0
Grafoman
1. 12. 2022   #1
-
0
-

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?

 

Nahlásit jako SPAM
IP: 94.113.175.–
JerryM0
Věrný člen
1. 12. 2022   #2
-
0
-

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

Nahlásit jako SPAM
IP: 2a00:1028:83bc:e52a:1833:f926:4355:e586...–
peter
~ Anonymní uživatel
3972 příspěvků
2. 12. 2022   #3
-
0
-

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)
Nahlásit jako SPAM
IP: 2001:718:2601:258:d49f:940c:1160:9bac...–
peter
~ Anonymní uživatel
3972 příspěvků
2. 12. 2022   #4
-
0
-

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)
Nahlásit jako SPAM
IP: 2001:718:2601:258:d49f:940c:1160:9bac...–
peter
~ Anonymní uživatel
3972 příspěvků
2. 12. 2022   #5
-
0
-

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

Nahlásit jako SPAM
IP: 2001:718:2601:258:d49f:940c:1160:9bac...–
oxidián0
Grafoman
2. 12. 2022   #6
-
0
-

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.

Nahlásit jako SPAM
IP: 78.102.61.–
gna
~ Anonymní uživatel
1847 příspěvků
2. 12. 2022   #7
-
0
-

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

Nahlásit jako SPAM
IP: 213.211.51.–
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 1 host

Podobná vlákna

Nastavení barev — založil Alan

Míchání barev — založil Spectator

Změna barev — založil Lukáš

Moderátoři diskuze

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032024 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý