將宏應用於工作表中的每個圖表

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

嘗試將每個chartobject參數更改為a，但我搞砸了所有內容...

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