在Excel VBA中循環瀏覽一組特定的圖表

Question

我想在一張工作表中僅循環一組特定的圖表，然后將其應用於一組格式（標題字體大小，標題位置，軸大小，網格線格式等）。

問題在於該工作表上已經有66個手動創建的圖表（1到66）。 現在，我將添加更多但自動生成的圖表，並且僅針對那些我想應用所需格式的圖表。

現在，我設法創建了圖表並分別應用了格式。 但是為了使其更加流暢，我需要一個我還沒有弄清楚的循環。 我的想法是/打算對工作表中的所有圖表進行計數，然后執行類似“ If cnt> 66 Then”的操作，在此處將代碼從cht.Activate行開始。

我的問題是統計所有圖表。 我正在猜測使用類似

with For -> For i to .CharObjects(i) 。 但也許您可以提出另一種方法。

Public Sub TEST()

Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range
Dim cht As ChartObject, cht1 As ChartObject, cht2 As ChartObject, cht3 As ChartObject
Dim LastRow As Long
Dim wsG As Worksheet:     Set wsG = ThisWorkbook.Worksheets("Charts")
Dim wsS As Worksheet:     Set wsS = ThisWorkbook.Worksheets("Scatter Raw")

LastRow = wsS.Cells(wsS.Rows.count, "A").End(xlUp).Row
Set rng1 = wsS.Range("A4:B" & LastRow)
Set rng2 = wsS.Range("H4:I" & LastRow)
Set rng3 = wsS.Range("O4:P" & LastRow)
Set cht1 = wsG.ChartObjects.Add(Range("A595").Left, Range("A595").Top, Width:=518.5, Height:=296.7)
Set cht2 = wsG.ChartObjects.Add(Range("M595").Left, Range("M595").Top, Width:=518.5, Height:=296.7)
Set cht3 = wsG.ChartObjects.Add(Range("Y595").Left, Range("Y595").Top, Width:=518.5, Height:=296.7)

cht1.Chart.SetSourceData Source:=rng1
cht1.Chart.ChartType = xlXYScatter
cht1.ShapeRange.LockAspectRatio = msoTrue
cht1.Activate
    With ActiveChart
    .FullSeriesCollection(1).Name = "=""NAME 1"""
    .ChartTitle.Text = "TITLE 1"
    End With

cht2.Chart.SetSourceData Source:=rng2
cht2.Chart.ChartType = xlXYScatter
cht2.ShapeRange.LockAspectRatio = msoTrue
cht2.Activate
    With ActiveChart
    .FullSeriesCollection(1).Name = "=""NAME 2"""
    .ChartTitle.Text = "TITLE 2"
    End With

cht3.Chart.SetSourceData Source:=rng3
cht3.Chart.ChartType = xlXYScatter
cht3.ShapeRange.LockAspectRatio = msoTrue
cht3.Activate
    With ActiveChart
    .FullSeriesCollection(1).Name = "=""NAME 3"""
    .ChartTitle.Text = "TITLE 3"
    End With

For Each cht In wsG.ChartObjects
    cht.Activate
    With ActiveChart
        .Legend.Delete
        .ChartTitle.Font.Size = 14
        .ChartTitle.Select
        With Selection.Format.TextFrame2.TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0.150000006
            .Transparency = 0
            .Solid
        End With
        Selection.Left = 27.536
        Selection.Top = 5

        .ChartArea.Select
        With Selection.Format.Line
            .Visible = msoFalse
        End With

        With .Axes(xlValue).TickLabels.Font
        .Size = 11
        End With
        .Axes(xlValue).Select
        Selection.Format.Line.Visible = msoFalse

        .Axes(xlValue).MajorGridlines.Select
        With Selection.Format.Line
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = -0.25
            .Transparency = 0
            .Visible = msoTrue
            .DashStyle = msoLineDash
        End With
    End With
Next cht

End Sub

Answer 1

如果要忽略Chart 3和Chart 2 ，請將這兩個名稱添加到數組中。 然后檢查圖表對象是否具有此數組的名稱並采取相應措施：

Public Sub TestMe()

    Dim myChart As ChartObject
    Dim chartCount As Long
    Dim cnt As Long

    Dim chartNamesToExclude As Variant
    chartNamesToExclude = Array("Chart 3", "Chart 2")        
    For Each myChart In Worksheets(1).ChartObjects
        If Not valueInArray(myChart.Name, chartNamesToExclude) Then
            cnt = cnt + 1
            myChart.Chart.ChartTitle.Text = "Title" & cnt
        End If
    Next myChart

End Sub

Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean

    Dim cnt As Long    
    For cnt = LBound(myArray) To UBound(myArray)
        If CStr(myValue) = CStr(myArray(cnt)) Then
            valueInArray = True
            Exit Function
        End If
    Next cnt

End Function

上面的代碼遍歷Worksheets(1)所有圖表，並將其標題相應地更改為Title N 它通過查看名稱位於chartNamesToExclude數組中的圖表來忽略名稱為Chart 3和Chart 2 。

Answer 2

感謝Vityata。 您的解決方案有效，但我想我一開始就找到了想要的東西。 我不知道它是否更好，但它也可以做到。 這里是。 干杯，丹尼爾

Private Sub newtest()

Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range
Dim cht As ChartObject, cht1 As ChartObject, cht2 As ChartObject, cht3 As    ChartObject
Dim LastRow As Long
Dim wsG As Worksheet:     Set wsG = ThisWorkbook.Worksheets("Charts Radio")
Dim wsS As Worksheet:     Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
Dim i As Long


For i = 67 To wsG.ChartObjects.count
    wsG.ChartObjects(i).Activate
        With ActiveChart
            .Legend.Delete
            .ChartTitle.Font.Size = 14
            .ChartTitle.Select
          With Selection.Format.TextFrame2.TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0.150000006
            .Transparency = 0
            .Solid
          End With
        Selection.Left = 27.536
        Selection.Top = 5
      'Added more formating / code here
    End With
Next
End Sub