为工作表中的每个图表应用宏

时间:2014-09-18 09:38:55

标签: excel vba excel-vba

我有这个宏我希望能在活动工作表的每个图表中运行它

Sub ColorRangeValues()
    Dim i As Long
    ActiveSheet.ChartObjects(1).Activate
    For i = 1 To ActiveChart.SeriesCollection.Count
        With ActiveChart.SeriesCollection(i)
             Values_Array = .Values
             For j = LBound(Values_Array, 1) To UBound(Values_Array, 1)
                 Select Case Values_Array(j)
                        Case Is < Range("B7")
                             .Points(j).Interior.Color = RGB(217, 0, 0)
                        Case Is > Range("B8")
                             .Points(j).Interior.Color = RGB(0, 128, 0)
                        Case Else
                              .Points(j).Interior.Color = RGB(192, 192, 192)
                 End Select
             Next
        End With
    Next
End Sub

尝试更改为每个chartobject参数的a,但我搞砸了所有内容......

1 个答案:

答案 0 :(得分:0)

你可以这样做:

Sub ColorRangeValues()
    Dim i                     As Long
    Dim oChtObj               As ChartObject

    For Each oChtObj In ActiveSheet.ChartObjects
        With oChtObj.Chart
            For i = 1 To .SeriesCollection.Count
                With .SeriesCollection(i)
                    Values_Array = .Values
                    For j = LBound(Values_Array, 1) To UBound(Values_Array, 1)
                        Select Case Values_Array(j)
                            Case Is < Range("B7")
                                .Points(j).Interior.Color = RGB(217, 0, 0)
                            Case Is > Range("B8")
                                .Points(j).Interior.Color = RGB(0, 128, 0)
                            Case Else
                                .Points(j).Interior.Color = RGB(192, 192, 192)
                        End Select
                    Next
                End With
            Next
        End With
    Next
End Sub