Excel 使用VBA为每张图纸创建唯一的图表

我正在尝试使用VBA在工作簿的每一页中创建图表。我使用了从网上收集的代码。我最接近成功的一次是在同一张图表的第一张纸上有28张

这是每个工作表在指定位置都有数据的代码

Sub WorksheetLoop()
  Dim WS_Count As Integer
  Dim I As Integer

  ' Set WS_Count equal to the number of worksheets in the active
  ' workbook.
  WS_Count = ActiveWorkbook.Worksheets.Count

  ' Begin the loop.
  For I = 1 To WS_Count
    ActiveSheet.Range("P2:AB2153").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterLines
    ActiveChart.SetSourceData Source:=Range("$P$2:$AB$2153")
    ActiveChart.Axes(xlValue).MinimumScale = 0.5
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 1").IncrementLeft 393.75
    ActiveSheet.Shapes("Chart 1").IncrementTop -31243.1249606299

    MsgBox ActiveWorkbook.Worksheets(I).Name
  Next I
End Sub

---

您会注意到，我在创建形状后移动了它。这是因为第一次它们都位于一张很长的纸的底部

然后我尝试添加

Dim thisSheet As Worksheet

For Each sheet In Sheets

并将

ActiveSheet更改为thisheet

没有成功

我在许多工作簿中有100多张工作表

---

如有任何帮助，我们将不胜感激。

已编译但未测试：

Sub WorksheetLoop()

    Dim WS As Worksheet, co As Object

    For Each WS In ActiveWorkbook.Worksheets

        Set co = WS.Shapes.AddChart()

        ActiveSheet.Range("P2:AB2153").Select

        'adjust to suit...
        co.Top = 100
        co.Left = 100
        co.Width = 300
        co.Height = 250

        With co.Chart
            .ChartType = xlXYScatterLines
            .SetSourceData Source:=WS.Range("$P$2:$AB$2153")
            .Axes(xlValue).MinimumScale = 0.5
        End With

        Debug.Print "Processed: " & WS.Name

    Next WS
End Sub

---

已编译但未测试：

Sub WorksheetLoop()

    Dim WS As Worksheet, co As Object

    For Each WS In ActiveWorkbook.Worksheets

        Set co = WS.Shapes.AddChart()

        ActiveSheet.Range("P2:AB2153").Select

        'adjust to suit...
        co.Top = 100
        co.Left = 100
        co.Width = 300
        co.Height = 250

        With co.Chart
            .ChartType = xlXYScatterLines
            .SetSourceData Source:=WS.Range("$P$2:$AB$2153")
            .Axes(xlValue).MinimumScale = 0.5
        End With

        Debug.Print "Processed: " & WS.Name

    Next WS
End Sub

---

我想出了自己的答案，并添加了一些其他内容

---

:

子工作表loopchart（）

---

索引+1成功了

我想出了自己的答案，并添加了一些其他内容

---

:

子工作表loopchart（）

---

指数+1成功了

谢谢蒂姆。我也会试试的谢谢Tim。我也会试试看