Loops Excel中的VBA，循环继续运行

我在Excel中有一个图表，我试图让一个循环更改图表中一个条形的颜色，然后引用一个单元格作为导出图像文件的名称。循环运行了多次，最后我得到了50个图表，其中有相同的高亮显示条，有50个不同的名称。我的最终目标是更改50个黄色条中的一个条的颜色，使用位于单元格D3中的名称导出该图表，然后将所有条更改回相同的颜色，移动到下一个条，将其更改为黄色，并使用位于单元格D4中的名称导出该图表

最后50个图表名称位于D3:D53范围内。下面是我的代码。非常感谢你的帮助

Dim i为整数，n为整数

将第1部分设置为字符串

For i = 1 To 50
For n = 3 To 52
part1 = Cells(n, 4)

ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(i).Select
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 255, 0)
    .Transparency = 0
    .Solid
End With

ActiveSheet.ChartObjects("Chart 1").Activate

ActiveChart.Export "ImageSaveLocation" & part1 & ".png"


ActiveChart.SeriesCollection(1).Select
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 112, 192)
    .Transparency = 0
    .Solid
End With

        Next n
    Next i

---

End Sub

我想你的代码不是无限循环，只是速度太慢了

添加一些应用程序。ScreenUpdate在开始时为false（在结束时为true）

避免使用。选择/激活

dim i as long, n as long 'and not integer wich is slower , 

使用集

dim chartColl as Series 'or seriescollection ? (not sure, try)
set ChartColl= ActiveChart.SeriesCollection(1)

配合使用

with ChartColl.points(i).format.fill  'untested
    .visible= msoTrue
    '...
end with

---

小提示：您将创建大约2500个*.png文件，因此您的硬盘速度将非常重要

不知道为什么要嵌套For循环

据我所知，您只需更改ActiveChart中某个系列的颜色，在D列中使用名称导出，恢复颜色，然后更改图表中的下一个系列

下面的代码应该工作得很好（假设在ActiveSheet的第一个图表上执行操作）：

Sub ChartExport()
    ' Chart Names in D3:D53
    Const lTop = 3
    Dim i As Long, lColor As Long, part1 As String

    Application.ScreenUpdating = False
    With ActiveSheet.ChartObjects(1).Chart
        For i = 1 To .SeriesCollection.Count
            part1 = ActiveSheet.Cells(lTop + i - 1).Value
            Application.StatusBar = "Exporting Chart " & part1 & " (" & i & ")..."
            ' Store Original Color, Change, Export then Restore color
            lColor = .SeriesCollection(i).Format.Fill.ForeColor.RGB
            .SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
            .Export "ImageSaveLocation" & part1 & ".png"
            .SeriesCollection(i).Format.Fill.ForeColor.RGB = lColor
        Next
    End With
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub