首页 文章

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

提问于
浏览 次
0

在工作中我总共有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中打开的工作表上，它将无法运行并在工作簿中的每个工作表上运行宏 . 有任何想法吗？

提前致谢

excel vba excel-vba charts

1 回答

  • 0

    你可以从循环遍历所有 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 工作表传递给您的函数并在该工作表上运行您的代码 . 有关详细信息，请参阅：Macro to Loop Through All Worksheets in a Workbook

    在这种情况下，您可以像这样更改代码：

    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
    回复于

相关问题