Diagramm von allen Arbeitsblättern
20.12.2016 12:04:29
allen
aktuell arbeite ich mit nachfolgendem Makro, mit dessen Hilfe ein Diagramm von allen Tabellenblättern erstellt wird. Hierbei muss allerdings immer erst der Name des ersten Tabellenblatts in den VBA-Code eingetragen werden. Hab mich auch schon daran versucht das zu ändern, was mir aber nicht gelungen ist :(
Sub Diagramm_erstellen_alle()
Dim wshTabelle As Worksheet
With Charts.Add
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Worksheets("RT_3xNaseAnGeschlizt1").Range("G1")
.SeriesCollection(1).Name = Worksheets("RT_3xNaseAnGeschlizt1").Range("G1")
.SeriesCollection(1).XValues = Worksheets("RT_3xNaseAnGeschlizt1").Range("S6:S18000")
.SeriesCollection(1).Values = Worksheets("RT_3xNaseAnGeschlizt1").Range("R6:R18000")
.Name = "DiagrammRT_3xNaseAnGeschlizt1"
.HasTitle = True
.ChartTitle.Characters.Text = "RT_3xNaseAnGeschlizt1"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Weg [mm]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Kraft [KN]"
.Axes(xlCategory).HasMajorGridlines = True
.HasLegend = False
With .PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
With .PlotArea.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
With .Axes(xlCategory)
.MinimumScale = 0
.MaximumScale = 9
.MajorUnit = 1
.DisplayUnit = xlNone
End With
With .Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 2
.MajorUnit = 0.2
.DisplayUnit = xlNone
End With
With .Axes(xlCategory).MajorGridlines.Border
.ColorIndex = 15
.Weight = xlHairline
.LineStyle = xlContinuous
End With
With .Axes(xlValue).MajorGridlines.Border
.ColorIndex = 15
.Weight = xlHairline
.LineStyle = xlContinuous
End With
With .Axes(xlCategory)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True
.DisplayUnit = xlNone
End With
With .Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True
.DisplayUnit = xlNone
End With
For Each wshTabelle In Worksheets
If wshTabelle.Name "RT_3xNaseAnGeschlizt1" Then
.SeriesCollection.NewSeries
With .SeriesCollection(.SeriesCollection.Count)
.Name = wshTabelle.Range("G1")
.XValues = wshTabelle.Range("S6:S18000")
.Values = wshTabelle.Range("R6:R18000")
End With
End If
Next wshTabelle
End With
End Sub
Vielleicht könnt Ihr mir helfen?
Viele Grüße
Benjamin
Anzeige