在 Excel 的多个工作表中重复使用图表（使用宏）

Question

我正在尝试使用宏来编写代码，以帮助我为我现在正在处理的 122 个工作表绘制多个图表。 问题是每个工作表都完全相同，除了要绘制或更改的值。 我已经编写了以下代码，但我无法一次将其应用于多个工作表，并且宏结果特定于它所在的工作表。 请帮忙

Sub ChartMacro()
'
' ChartMacro Macro
'
' Keyboard Shortcut: Ctrl+m
'
 Dim sSheetName As String

    sSheetName = ActiveSheet.Name
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveWindow.SmallScroll Down:=27

    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""China"""
    ActiveChart.SeriesCollection(1).Values = "=('&sSheetName&'!$E$11)"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Name = "='sSheetName'!$D$14:$E$14"
    ActiveChart.SeriesCollection(2).Values = "='sSheetName'!$E$20"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(3).Name = "='sSheetName'!$D$23:$E$23"
    ActiveChart.SeriesCollection(3).Values = "='sSheetName'!$E$29"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(4).Name = "='sSheetName'!$D$32:$E$32"
    ActiveChart.SeriesCollection(4).Values = "='sSheetName'!$E$38"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(5).Name = "='sSheetName'!$D$41:$E$41"
    ActiveChart.SeriesCollection(5).Values = "='sSheetName'!$E$47"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(6).Name = "='sSheetName'!$D$50:$E$50"
    ActiveChart.SeriesCollection(6).Values = "='sSheetName'!$E$56"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(7).Name = "='sSheetName'!$D$59:$E$59"
    ActiveChart.SeriesCollection(7).Values = "='sSheetName'!$E$65"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(8).Name = "=""Singapore"""
    ActiveChart.SeriesCollection(8).Values = "='sSheetName'!$E$74"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(9).Name = "='sSheetName'!$D$77:$E$77"
    ActiveChart.SeriesCollection(9).Values = "='sSheetName'!$E$83"
    ActiveChart.SeriesCollection(9).XValues = "='sSheetName'!$A$3:$U$3"

    ActiveChart.ApplyLayout (3)
    ActiveChart.PlotArea.Select
    ActiveChart.Axes(xlCategory).Select
    Selection.TickLabelPosition = xlHigh
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "Male-Female"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "Male-Female"

    With Selection.Format.TextFrame2.TextRange.Characters(1, 11).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With

    With Selection.Format.TextFrame2.TextRange.Characters(1, 11).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With

    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
End Sub

Answer 1

我会用 Worksheet 对象替换 sSheetName。然后你需要稍微修改你的代码来使用这些新对象。

Sub chartMacro()
'
' ChartMacro Macro
'
' Keyboard Shortcut: Ctrl+m
'
    Dim sheet as Worksheet
    Dim cht as Chart

    Set sheet = ActiveSheet
    Set cht = Charts.Add
    Set cht = cht.Location(Where:=xlLocationAsObject, Name:=sheet.Name)

    cht.ChartType = xlColumnClustered

    cht.SeriesCollection.NewSeries
    cht.SeriesCollection(1).Name = "=""China"""
    cht.SeriesCollection(1).Values = Sheet.Cells(11,5)

    cht.SeriesCollection.NewSeries
    cht.SeriesCollection(2).Name = Sheet.Range("$D$14:$E$14")
    cht.SeriesCollection(2).Values = Sheet.Range("$E$20")
    '...rest of sub follows...

End Sub

您还可以通过循环 SeriesCollection 来稍微清理一下代码，因为看起来您每次将 Sheet.Range() 递增 9 行。