首页 > 解决方案 > 如何将图表从一张表复制到另一张表或设置图表的目的地?

问题描述

所以我的代码是如何工作的,它将根据 A 列中的 X 值绘制图表,y 列是交替列(例如:mean graph x values=entirecolumn1, y values = entirecolumn 2,4,6..etc, sigma 图 x 值 = 整列 1,y 值 = 整列 3、5、7 ..)。

我所有的图表都绘制在同一个工作表(“数据”)上,但我发现它非常混乱。我试图将所有图表复制并粘贴到不同的工作表中,即 sigmagraphs 和 meangraphs,但它只复制和粘贴 meangraphs 部分(不确定哪里出错了)。那么我能做些什么来确保数据中的所有图表都相应地复制和粘贴到不同的工作表,或者是否可以将图表的目的地从开始设置为工作表 sigmagraphs 和 meangraphs?

无论如何,我没有包含 sigmagraphs 的代码,因为代码会太长,但代码几乎与 set rngY = rngDB.Columns(3) 和不同轴的 meangraphs 的代码相同。

在此处输入图像描述

Sub plotgraphs()

Call meangraph
Call sigmagraph

End Sub

Private Sub meangraph()
    Dim i As Long, c As Long
    Dim shp As Shape
    Dim Cht As chart, co As Shape
    Dim rngDB As Range, rngX As Range, rngY As Range
    Dim Srs As Series
    Dim ws As Worksheet

    Set ws = Sheets("Data")

    Set rngDB = ws.Range("A1").CurrentRegion

    Set rngX = rngDB.Columns(1)
    Set rngY = rngDB.Columns(2)

    Do While Application.CountA(rngY) > 0

        Set co = ws.Shapes.AddChart
        Set Cht = co.chart

        With Cht
            .ChartType = xlXYScatter
            'remove any data which might have been
            '  picked up when adding the chart
            Do While .SeriesCollection.Count > 0
                .SeriesCollection(1).Delete
            Loop
            'add the data
            With .SeriesCollection.NewSeries()
                .XValues = rngX.Value
                .Values = rngY.Value
            End With
            'formatting...
            With Cht.Axes(xlValue)
                .MinimumScale = 5
                .MaximumScale = 20
                .TickLabels.NumberFormat = "0.00E+00"
            End With
            Cht.Axes(xlCategory, xlPrimary).HasTitle = True
            Cht.Axes(xlValue, xlPrimary).HasTitle = True
        End With
          Set rngY = rngY.Offset(0, 2) 'next y values

    Loop




              Dim OutSht As Worksheet
'
   Dim PlaceInRange As Range

    Set OutSht = ActiveWorkbook.Sheets("sigmagraphs") '<~~ Output sheet
   Set PlaceInRange = OutSht.Range("B2:J21")        '<~~ Output location
'


'    To place charts at a distance between them
    For Each chart In Sheets("sigmagraphs").ChartObjects
'        OutSht.Paste PlaceInRange
'        Code below changes the range itself to something 20 rows below
        Set PlaceInRange = PlaceInRange.Offset(20, 0)
   Next chart

End Sub

预期输出(其中图表根据工作表名称排序)

在此处输入图像描述

标签: excelvbagraph

解决方案


推荐阅读