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

Question

我有一个宏，我想让它可以在活动工作表中的每个图表中运行

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

尝试更改为每个字符对象的参数，但我搞乱了一切……

Answer 1

你可以这样做：

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