mehrfache Schleifen
20.10.2014 11:16:42
Stankowski
arbeite seit Wochen an einem Programm zur Erstellung von mehreren (ca. 60) Diagrammen aus einem Datenblatt.
Ich will aber nicht 60 mal jedes Diagramm programmieren.
nun meine Frage:
wie bekomme ich für die Variablen zellbezüge (sind bei jedem Diagramm anders) eine schleife hin, die in den deffinierten Zellabständen (immer 8 zeilen) die Daten abfragt und in die vorbereiteten Diagramme (1 - 60) einträgt.
VBA anbei für 2 Diagramme (sollen aber mal 60 werden)
Sub Scale_Chart()
Dim myrange As Range
Dim answerMax As Single
Dim answerMin As Single
'Diagramm 1
Set myrange = Worksheets("Prüfkarte spc").Range("e7:h13")
answerMax = Application.WorksheetFunction.Max(myrange)
answerMin = Application.WorksheetFunction.Min(myrange)
Worksheets("Urwertkarte").ChartObjects("diagramm 1").Activate
ActiveChart.Axes(xlValue).MajorGridlines.Select
With ActiveChart.Axes(xlValue)
.MinimumScale = answerMin
.MaximumScale = answerMax
.MajorUnit = Worksheets("Prüfkarte spc").Range("j7")
.MinorUnit = Worksheets("Prüfkarte spc").Range("j8")
.Crosses = xlAutomatic
.CrossesAt = 0
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
'Beschrifung setzten
ActiveChart.Shapes(1).Delete
ActiveChart.Shapes.AddLabel(1, 0, 0, 200, 20).TextFrame.Characters.Text = _
Worksheets("Prüfkarte spc").Range("j13")
End With
'Diagramm 2
Set myrange = Worksheets("Prüfkarte spc").Range("e15:h21")
answerMax = Application.WorksheetFunction.Max(myrange)
answerMin = Application.WorksheetFunction.Min(myrange)
Worksheets("Urwertkarte").ChartObjects("diagramm 2").Activate
ActiveChart.Axes(xlValue).MajorGridlines.Select
With ActiveChart.Axes(xlValue)
.MinimumScale = answerMin
.MaximumScale = answerMax
.MajorUnit = Worksheets("Prüfkarte spc").Range("j15")
.MinorUnit = Worksheets("Prüfkarte spc").Range("j16")
.Crosses = xlAutomatic
.CrossesAt = 0
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
'Beschrifung setzten
ActiveChart.Shapes(1).Delete
ActiveChart.Shapes.AddLabel(1, 0, 0, 200, 20).TextFrame.Characters.Text = _
Worksheets("Prüfkarte spc").Range("j21")
End With
End Sub