PDA

View Full Version : Copy and paste styles of diagram



vangog
10-01-2022, 12:31 PM
Hello,

I have many diagrams with about 15 data sets and I need to copy the styles of lines from one diagram, and copy the styles to the rest of the diagrams (after been selected). This is to do on very old Excel. I have 30 sheets - every contains 3 diagrams like that. So too hard to do it manially. I need to set the color of the like, color of the mark and the style of the mark (disabled/enabled). Can you please help with some VBA script to do?

Aussiebear
10-01-2022, 05:30 PM
Once again.... attach a workbook with sample diagrams. Attachments (images) are nearly worthless to us.

vangog
10-02-2022, 12:04 AM
I added data to separate file, 3 lists of data and one list of diagrams 30198 (diagram #1 source link corrected 9:16 AM)

snb
10-02-2022, 02:46 AM
But you didn't indicate what should be changed into what.

vangog
10-02-2022, 03:46 AM
There is problem that every column uses different color for curves. I need to copy the first diagram styles and paste them onto the selected diagrams. Possibly using VBA script. I would do that with the rest of the diagrams. I want to have all lines in same colors, same settings as in the first diagram in 'G30'. There is a lot of columns in that tables and setting every diagram colors would be very very hard.

snb
10-02-2022, 04:55 AM
Fisrt you should remove dataseries 'days' form the first diagram.

Then run:


Sub M_snb()
For Each it In Sheet4.ChartObjects
For j = 1 To it.Chart.SeriesCollection.Count
it.Chart.SeriesCollection(j).Format.Line.ForeColor.ObjectThemeColor = j
it.Chart.SeriesCollection(j).MarkerStyle = j \ 5
it.Chart.SeriesCollection(j).MarkerSize = 3
it.Chart.SeriesCollection(j).MarkerForegroundColor = j \ 5
Next
Next
End Sub

vangog
10-06-2022, 12:47 PM
Fisrt you should remove dataseries 'days' form the first diagram.

Then run:


Thank you.

vangog
10-06-2022, 01:03 PM
How to modify the code to print the values from these properties to some sheet? I would write a macro but I need to get the values from the properties first. I mean something like:

For Each it In Worksheets("G7").ChartObjects
For j = 1 To it.Chart.SeriesCollection.Count
Worksheets("t").Cells(i, j) = it.Chart.SeriesCollection(j).Format.Line.ForeColor.ObjectThemeColor
Worksheets("t").Cells(i, j + 1) = it.Chart.SeriesCollection(j).MarkerStyle
Worksheets("t").Cells(i, j + 2) = it.Chart.SeriesCollection(j).MarkerSize
Worksheets("t").Cells(i, j + 3) = it.Chart.SeriesCollection(j).MarkerForegroundColor
Next
Next

georgiboy
10-07-2022, 07:12 AM
Perhaps something along the lines of:

Sub test()
Dim it As ChartObject, j As Integer, i As Integer, r As Integer, wsT As Worksheet

Set wsT = Sheets("t")

For Each it In Worksheets("G7").ChartObjects
For j = 1 To it.Chart.SeriesCollection.Count
r = r + 1
With it.Chart.SeriesCollection(j)
wsT.Cells(r, 1) = .Format.Line.ForeColor
wsT.Cells(r, 2) = .MarkerStyle
wsT.Cells(r, 3) = .MarkerSize
wsT.Cells(r, 4) = .MarkerForegroundColor
End With
Next
Next
End Sub

vangog
10-08-2022, 11:34 PM
Perhaps something ...

Thank you. I have modified your code to work on ActiveChart, but I got error on the line
wsT.Cells(r, 1) = .Format.Line.ForeColor:


Sub extract_chart_styles()
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) = .Format.Line.ForeColor
wsT.Cells(r, 2) = .MarkerStyle
wsT.Cells(r, 3) = .MarkerSize
wsT.Cells(r, 4) = .MarkerForegroundColor
End With
Next
End Sub


It looks like in old Excel the member Format does not exist. However there is a Fill member. So this works when I replace Format.Line to Fill.
extract_chart_styles()
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
wsT.Cells(r, 2) = .MarkerStyle
wsT.Cells(r, 3) = .MarkerSize
wsT.Cells(r, 4) = .MarkerForegroundColor
End With
Next
End Sub

vangog
10-13-2022, 12:06 AM
So far I have two procedures. One to extract styles from selected Chart. And the next one to set the styles... That one takes the table in sheets("t") as source. But I have problem setting the styles with an error. Can you please help to finish this?



Sub extract_styles_of_specific_chart()
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
wsT.Cells(r, 2) = .MarkerStyle
wsT.Cells(r, 3) = .MarkerSize
wsT.Cells(r, 4) = .MarkerForegroundColor
End With
Next
End Sub


Try to set the styles on charts of some active Sheet of Charts:


Sub set_chart_styles_from_table()

Dim wsS As Worksheet, it As ChartObject, table As Range, c As Integer, l As Integer, ChartSheetName As String
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
For Each it In ActiveSheet.ChartObjects
it.Chart.SeriesCollection(l).Fill.ForeColor = table.Rows(l).Columns.Cells(1).Value
it.Chart.SeriesCollection(l).MarkerStyle = table.Rows(l).Columns.Cells(2).Value
it.Chart.SeriesCollection(l).MarkerSize = table.Rows(l).Columns.Cells(3).Value
it.Chart.SeriesCollection(l).MarkerForegroundColor = table.Rows(l).Columns.Cells(4).Value
Next it
Next
End Sub


The error here:
error 450: Wrong number of arguments or invalid property assignment ...

The value of table.Rows(l).Columns.Cells(1).Value
checked in a watch and it is Correct
Example values from the first row:


10077403

-4142

5

58

georgiboy
10-13-2022, 01:31 AM
See attached

vangog
10-13-2022, 03:56 AM
Thank you but can you please save the file as .xls? Or just paste the VBA code. I cannot open your file.

Edit:
I managed to open it in LibreOffice. Now studing the code.

vangog
10-15-2022, 10:28 AM
Currently I am having this problem:

it.Chart.SeriesCollection(l).Fill.ForeColor.RGB = RGB(R, G, B)
Generates error wrong number of arguments or invalid property assigment.

vangog
10-15-2022, 02:01 PM
See attached

Is it possible that the fill property would be read only? For any reason? In the old excel there is no property format or line, so I wonder how to set color on Windows XP. Also I have noticed .MarkerForegroundColor is most times 58 : I copy the rows here:


58



58



58



58



58



57


10



58



58


58


58


57


57



46



And it means that it sets to black color. Which is pretty odd.