1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
| Sub ColorChartColumnsbyCellColor()
'Updateby Extendoffice
Dim xChart As Chart
Dim I As Long, xRows As Long
Dim xRg As Range, xCell As Range
On Error Resume Next
Set xChart = ActiveSheet.ChartObjects("Chart 1").Chart
If xChart Is Nothing Then Exit Sub
With xChart.SeriesCollection(1)
Set xRg = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
xRows = xRg.Rows.Count
Set xRg = xRg(1)
For I = 1 To xRows
.Points(1).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(2)
For I = 1 To xRows
.Points(2).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(3)
For I = 1 To xRows
.Points(3).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(4)
For I = 1 To xRows
.Points(4).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(5)
For I = 1 To xRows
.Points(5).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(6)
For I = 1 To xRows
.Points(6).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(7)
For I = 1 To xRows
.Points(7).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(8)
For I = 1 To xRows
.Points(8).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(9)
For I = 1 To xRows
.Points(9).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
End With
Set xChart = ActiveSheet.ChartObjects("Chart 2").Chart
If xChart Is Nothing Then Exit Sub
With xChart.SeriesCollection(1)
Set xRg = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
xRows = xRg.Rows.Count
Set xRg = xRg(1)
For I = 1 To xRows
.Points(1).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(2)
For I = 1 To xRows
.Points(2).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(3)
For I = 1 To xRows
.Points(3).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(4)
For I = 1 To xRows
.Points(4).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(5)
For I = 1 To xRows
.Points(5).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(6)
For I = 1 To xRows
.Points(6).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(7)
For I = 1 To xRows
.Points(7).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(8)
For I = 1 To xRows
.Points(8).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
Set xRg = xRg(9)
For I = 1 To xRows
.Points(9).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xRg.Offset(I - 1, 0).Interior.ColorIndex)
Next
End With
End Sub |
(
