如何在相应的图表上绘制图表?

我正在从多个电子表格中获取数据,并将它们绘制在图表上。 我希望Spreadsheet1的数据也可以在Spreadsheet1上绘制一个图表。 目前,我的代码绘制了最后一张纸上的所有graphics,所以图1,2,3等的graphics都绘制在最后一张纸上。 我不确定如何解决这个问题,因为我是VBA新手。 我logging了一个macros来获取代码来绘制数据。

这里是我的密码:

For j = 1 To size 'creates chart ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select ActiveSheet.Shapes("Chart 1").IncrementLeft 696.75 ActiveSheet.Shapes("Chart 1").IncrementTop -81.75 ActiveSheet.Shapes("Chart 1").ScaleWidth 1.3333333333, msoFalse, _ msoScaleFromTopLeft ActiveSheet.Shapes("Chart 1").ScaleHeight 1.6909722222, msoFalse, _ msoScaleFromTopLeft Application.CutCopyMode = False Application.CutCopyMode = False Application.CutCopyMode = False Application.CutCopyMode = False Application.CutCopyMode = False Application.CutCopyMode = False ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(1).Name = "=""Length and Depth Data""" ActiveChart.FullSeriesCollection(1).XValues = Worksheets("Case " & overview(j, 1)).Range("$R$10:$R$6000") ActiveChart.FullSeriesCollection(1).Values = Worksheets("Case " & overview(j, 1)).Range("$S$10:$S$6000") ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(2).Name = "=""B31G MAOP""" ActiveChart.FullSeriesCollection(2).XValues = Worksheets("Case " & overview(j, 1)).Range("$C$10:$C$159") ActiveChart.FullSeriesCollection(2).Values = Worksheets("Case " & overview(j, 1)).Range("$I$10:$I$159") ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(3).Name = "=""B31G 1.25SF""" ActiveChart.FullSeriesCollection(3).XValues = Worksheets("Case " & overview(j, 1)).Range("$C$10:$C$159") ActiveChart.FullSeriesCollection(3).Values = Worksheets("Case " & overview(j, 1)).Range("$J$10:$J$159") ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(4).Name = "=""B31G 1.39SF""" ActiveChart.FullSeriesCollection(4).XValues = Worksheets("Case " & overview(j, 1)).Range("$C$10:$C$159") ActiveChart.FullSeriesCollection(4).Values = Worksheets("Case " & overview(j, 1)).Range("$P$10:$P$159") ActiveWindow.SmallScroll Down:=-126 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.SmallScroll Down:=6 Range("W32").Select ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select ActiveSheet.Shapes("Chart 2").IncrementLeft 311.25 ActiveSheet.Shapes("Chart 2").IncrementTop 213 ActiveWindow.SmallScroll Down:=18 Range("AD46:AD47").Select ActiveSheet.ChartObjects("Chart 2").Activate ActiveSheet.ChartObjects("Chart 2").Activate ActiveSheet.Shapes("Chart 2").ScaleWidth 1.3145833333, msoFalse, _ msoScaleFromTopLeft ActiveSheet.Shapes("Chart 2").ScaleHeight 1.4930555556, msoFalse, _ msoScaleFromTopLeft ActiveSheet.ChartObjects("Chart 2").Activate Application.CutCopyMode = False Application.CutCopyMode = False Application.CutCopyMode = False ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(1).Name = "=""Length and Depth Data""" ActiveChart.FullSeriesCollection(1).XValues = Worksheets("Case " & overview(j, 1)).Range("$R$10:$R$6000") ActiveChart.FullSeriesCollection(1).Values = Worksheets("Case " & overview(j, 1)).Range("$S$10:$S$6000") ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(2).Name = "=""MB31G MAOP""" ActiveChart.FullSeriesCollection(2).XValues = Worksheets("Case " & overview(j, 1)).Range("$C$10:$C$159") ActiveChart.FullSeriesCollection(2).Values = Worksheets("Case " & overview(j, 1)).Range("$N$10:$N$159") ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(3).Name = "=""MB31G 1.25SF""" ActiveChart.FullSeriesCollection(3).XValues = Worksheets("Case " & overview(j, 1)).Range("$C$10:$C$159") ActiveChart.FullSeriesCollection(3).Values = Worksheets("Case " & overview(j, 1)).Range("$O$10:$O$159") ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(4).Name = "=""B31G 1.39SF""" ActiveChart.FullSeriesCollection(4).XValues = Worksheets("Case " & overview(j, 1)).Range("$C$10:$C$159") ActiveChart.FullSeriesCollection(4).Values = Worksheets("Case " & overview(j, 1)).Range("$P$10:$P$159") ActiveWindow.SmallScroll Down:=-117 ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.PlotArea.Select ActiveChart.SetElement (msoElementChartTitleAboveChart) ActiveWindow.SmallScroll Down:=9 ActiveChart.ChartTitle.Text = "B31G Burst Curve" Selection.Format.TextFrame2.TextRange.Characters.Text = "B31G Burst Curve" With Selection.Format.TextFrame2.TextRange.Characters(1, 16).ParagraphFormat .TextDirection = msoTextDirectionLeftToRight .Alignment = msoAlignCenter End With With Selection.Format.TextFrame2.TextRange.Characters(1, 16).Font .BaselineOffset = 0 .Bold = msoFalse .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(89, 89, 89) .Fill.Transparency = 0 .Fill.Solid .size = 14 .Italic = msoFalse .Kerning = 12 .Name = "+mn-lt" .UnderlineStyle = msoNoUnderline .Spacing = 0 .Strike = msoNoStrike End With ActiveSheet.ChartObjects("Chart 2").Activate ActiveChart.Axes(xlValue).MajorGridlines.Select ActiveChart.SetElement (msoElementChartTitleAboveChart) ActiveWindow.SmallScroll Down:=-12 ActiveChart.ChartTitle.Text = "B31G Burst Curve" Selection.Format.TextFrame2.TextRange.Characters.Text = "B31G Burst Curve" With Selection.Format.TextFrame2.TextRange.Characters(1, 16).ParagraphFormat .TextDirection = msoTextDirectionLeftToRight .Alignment = msoAlignCenter End With With Selection.Format.TextFrame2.TextRange.Characters(1, 4).Font .BaselineOffset = 0 .Bold = msoFalse .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(89, 89, 89) .Fill.Transparency = 0 .Fill.Solid .size = 14 .Italic = msoFalse .Kerning = 12 .Name = "+mn-lt" .UnderlineStyle = msoNoUnderline .Spacing = 0 .Strike = msoNoStrike End With With Selection.Format.TextFrame2.TextRange.Characters(5, 12).Font .BaselineOffset = 0 .Bold = msoFalse .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(89, 89, 89) .Fill.Transparency = 0 .Fill.Solid .size = 14 .Italic = msoFalse .Kerning = 12 .Name = "+mn-lt" .UnderlineStyle = msoNoUnderline .Spacing = 0 .Strike = msoNoStrike End With ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.ChartTitle.Select Application.CommandBars("Format Object").Visible = False ActiveChart.ChartTitle.Text = "MB31G Burst Curve" Selection.Format.TextFrame2.TextRange.Characters.Text = "MB31G Burst Curve" With Selection.Format.TextFrame2.TextRange.Characters(1, 17).ParagraphFormat .TextDirection = msoTextDirectionLeftToRight .Alignment = msoAlignCenter End With With Selection.Format.TextFrame2.TextRange.Characters(1, 17).Font .BaselineOffset = 0 .Bold = msoFalse .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(89, 89, 89) .Fill.Transparency = 0 .Fill.Solid .size = 14 .Italic = msoFalse .Kerning = 12 .Name = "+mn-lt" .UnderlineStyle = msoNoUnderline .Spacing = 0 .Strike = msoNoStrike End With Next j 

我会以完全不同的方式做到这一点。 但是,对于你提供的代码墙的一个快速修复,就是在你的for循环开始之后把这个添加到开头:

 For j = 1 To size 'creates chart Worksheets("Case " & overview(j, 1)).Activate 'Rest of the code would be the same '... Next j 

你应该阅读这个问题和答案:

如何避免在VBA中select和激活?

您应用ActiveSheet上的所有说明。 您可以按Sheets(1).Activate Sheets("sheet_name").ActivateSheets("sheet_name").Activateselect特定的Sheets(1).Activate Sheets("sheet_name").Activate

您也可以遍历所有表格

 For Each sht In ActiveWorkbook.Sheets If sht.Name Like "..." Then ... Next sht