グラフの正色と負色（Microsoft Excel）

Sub PosNegLine()

Dim chtSeries As Series     Dim SeriesNum As Integer     Dim SeriesColor As Integer     Dim MyChart As Chart     Dim R As Range     Dim i As Integer     Dim LineColor As Integer     Dim PosColor As Integer     Dim NegColor As Integer     Dim LastPtColor As Integer     Dim CurrPtColor As Integer

PosColor = 4 'Green     NegColor = 3 'red     SeriesNum = 1

Set MyChart = ActiveSheet.ChartObjects(1).Chart     Set chtSeries = MyChart.SeriesCollection(SeriesNum)

Set R = GetChartRange(MyChart, 1, "Values")



For i = 2 To R.Cells.Count         LastPtColor = IIf(R.Cells(i - 1).Value < 0, NegColor, PosColor)

CurrPtColor = IIf(R.Cells(i).Value < 0, NegColor, PosColor)



If LastPtColor = CurrPtColor Then             LineColor = LastPtColor         Else             If Abs(R.Cells(i - 1).Value) > Abs(R.Cells(i).Value) Then                 LineColor = LastPtColor             Else                 LineColor = CurrPtColor             End If         End If         chtSeries.Points(i).Border.ColorIndex = LineColor     Next i End Sub

Function GetChartRange(Ch As Chart, Ser As Integer, _   ValXorY As String) As Range     Dim SeriesFormula As String     Dim ListSep As String * 1     Dim Pos As Integer     Dim LSeps() As Integer     Dim Txt As String     Dim i As Integer

Set GetChartRange = Nothing

On Error Resume Next         SeriesFormula = Ch.SeriesCollection(Ser).Formula     ListSep = ","

For i = 1 To Len(SeriesFormula)

If Mid$(SeriesFormula, i, 1) = ListSep Then             Pos = Pos + 1             ReDim Preserve LSeps(Pos)

LSeps(Pos) = i         End If     Next i

If UCase(ValXorY) = "XVALUES" Then         Txt = Mid$(SeriesFormula, LSeps(1) + 1, LSeps(2) - LSeps(1) - 1)



Set GetChartRange = Range(Txt)

End If

If UCase(ValXorY) = "VALUES" Then         Txt = Mid$(SeriesFormula, LSeps(2) + 1, LSeps(3) - LSeps(2) - 1)



Set GetChartRange = Range(Txt)

End If End Function

http://www.peltiertech.com/Excel/Charts/ConditionalChart1.html