VBA将图表折线颜色复制到不同工作表中的许多图表



在工作中,我总共有 72 个 Excel 2010 工作簿,每个工作簿有 12 张纸,每张纸上都有一个图表(我认为这意味着图表没有嵌入?我是一名基础程序员,只在A-Level上涵盖了VB。

我需要工作簿中的所有图表(在 12 个单独的工作表上)具有与该工作簿中的第一个图表相同的彩色数据线。
我最初的想法是录制我手动更改线条颜色、粗细等的宏,然后查看此宏的代码并在其周围放置某种循环。

经过几个小时尝试不同的建议和许多谷歌搜索,我无法让它工作。

到目前为止,我拥有的代码如下:

Sub Macro1()
Dim i As Integer
Dim sht As Worksheet
For i = 1 To ActiveWorkbook.Worksheets.Count
Set sht = ActiveWorkbook.Sheets(i)
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.Select
ActiveChart.Legend.LegendEntries(1).Select
ActiveChart.SeriesCollection(1).Select
With Selection
    .MarkerStyle = 2
    .MarkerSize = 7
End With
Selection.MarkerStyle = -4168
Selection.Format.Fill.Visible = msoFalse
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorAccent1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .Weight = 1.25
End With
ActiveChart.Legend.Select
ActiveChart.Legend.LegendEntries(2).Select
ActiveChart.SeriesCollection(2).Select
With Selection
    .MarkerStyle = 1
    .MarkerSize = 7
End With
Selection.MarkerStyle = -4168
Selection.Format.Fill.Visible = msoFalse
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 112, 192)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 112, 192)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 112, 192)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .Weight = 1.25
End With
ActiveChart.Legend.Select
ActiveChart.Legend.LegendEntries(3).Select
ActiveChart.SeriesCollection(3).Select
With Selection
    .MarkerStyle = 3
    .MarkerSize = 7
End With
Selection.MarkerStyle = -4168
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorAccent1
    .ForeColor.TintAndShade = 0
'     .ForeColor.Brightness = 0
    .Solid
End With
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 176, 80)
    .Transparency = 0
    .Solid
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 112, 192)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 176, 80)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 176, 80)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 176, 80)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .Weight = 1.25
End With
Selection.Format.Fill.Visible = msoFalse
ActiveChart.Legend.Select
ActiveChart.Legend.LegendEntries(4).Select
ActiveChart.SeriesCollection(4).Select
With Selection
    .MarkerStyle = -4168
    .MarkerSize = 7
End With
Selection.Format.Fill.Visible = msoFalse
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 176, 80)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(112, 48, 160)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(112, 48, 160)
End With
With Selection.Format.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(112, 48, 160)
    .Transparency = 0
End With
With Selection.Format.Line
    .Visible = msoTrue
    .Weight = 1.25
End With

Next i

End Sub

此代码运行并执行我想要的操作,但仅在您实际在 excel 中打开的工作表上,它不会在工作簿中的每个工作表上运行和运行宏。有什么想法吗?

提前致谢

您可以从

循环遍历所有Worksheets的循环中调用Sub Macro1

例如:

Sub WorksheetLoop()
     ' Declare Current as a worksheet object variable.
     Dim Current As Worksheet
     ' Loop through all of the worksheets in the active workbook.
     For Each Current In Worksheets
        ' Insert your code here.
        ' This line displays the worksheet name in a message box.
        MsgBox Current.Name
     Next
End Sub

然后,您可以将Current工作表传递给函数,并在该工作表上运行代码。有关详细信息,请参阅: 循环访问工作簿中所有工作表的宏

在这种情况下,您可以像这样更改代码:

Sub Macro1(Byval Current As Worksheet)
    Dim i As Integer
    Dim sht As Worksheet
    For i = 1 To ActiveWorkbook.Worksheets.Count
    Set sht = Current
    sht.ChartObjects("Chart 1").Activate
    .....
End Sub

并创建一个这样的循环:

Sub WorksheetLoop()
     Dim Current As Worksheet
     For Each Current In Worksheets
        Call Macro1(Current)
     Next
End Sub

最新更新