在Excel的多个工作表中重复使用图形(使用宏)

时间:2016-06-23 15:32:51

标签: excel excel-vba macros vba

我正在尝试使用宏编写一个代码,帮助我为我正在处理的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

1 个答案:

答案 0 :(得分:0)

我会用echo $VERSION | awk 'BEGIN { FS=":" } { $3++; if ($3 > 99) { $3=0; $2++; if ($2 > 99) { $2=0; $1++ } } } { printf "%02d:%02d:%02d\n", $1, $2, $3 }' 对象替换sSheetName。然后你需要改变你的代码只是为了使用这些新对象。

Worksheet

您也可以通过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增加9行。