Question

我正在尝试使用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 to thisSheet

没有成功。

我在许多工作簿中有超过100张纸任何帮助将不胜感激

Answer 1

已编译但未经过测试：

MotorBike

Answer 2

我想出了自己的答案并添加了其他一些其他的东西

Sub WorksheetLoopchart（）

     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

    Worksheets(ActiveSheet.Index + 1).Select
    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.1
    ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Wavelength (nm)"
    ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Absolute Reflectance"
    ActiveChart.SetElement (msoElementLegendRight)

        ' Insert your code here.
        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ActiveWorkbook.Worksheets(I).Name

     Next I

  End Sub

指数+ 1做了招数

使用VBA

2 个答案: