Erstellen Sie ein eindeutiges Diagramm für jedes Blatt mit VBA

Question

Ich versuche, ein Diagramm in jedem Blatt meiner Arbeitsmappe mithilfe von VBA zu erstellen. Ich habe Code aus dem Netz verwendet. Der Erfolg, dem ich am nächsten kam, endete mit 28 derselben Karte auf dem ersten Blatt.

Hier ist der Code, wo jedes Blatt die Daten in der angegebenen Stelle hat

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 

---

Sie werden feststellen, dass ich die Form bewegt, nachdem sie erstellt wird. Das lag daran, das erste Mal, sie alle am Ende eines sehr langen Bogens angeordnet waren

ich dann Zugabe versucht

Dim thisSheet As Worksheet 

For Each sheet In Sheets 

und ActiveSheet to thisSheet

Kein wechselnden Erfolg.

Ich habe mehr als 100 Blätter in vielen Arbeitsmappen Jede Hilfe

Answer 1

Zusammengestellt geschätzt werden würde, aber nicht getestet:

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 

Answer 2

kam ich mit meiner eigenen Antwort und fügte etwas andere andere Sachen

---

:

UnterarbeitsblattLoopch Kunst()

 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 

Der Index + 1 hat den Trick