Diagramm Beschriftung der Graphen
Daniel
kann mir jemand sagen warum im folgen VBA Code (der funktioniert) folgendes passiert.
Und zwar erzeugt er asu dem Zahlenwert aus U377 eine zeitliche Abfolge und dann Werte die in ein Diagramm eingetragen werden. Dies passiert beim Klick auf ein Command Button. Nun die Frage wenn ich das erste mal klicke werden die einzelnen Graphen nicht benannt sondern es steht nur Reihe 1, Reihe 2, usw...
Beim zweiten Klick macht er das dann aber. Woran könnte es liegen das es beim ersten mal nicht passiert?
Hier der Code:
Sub Diagramm_erzeugen_Te()
Dim I As Long, Differenz As Double
Dim a As String
Const myRow = 377
Const myCol = 21
Const startWert = 0
a = Cells(373, 22)
Differenz = Application.InputBox(Prompt:="Bitte Zeitdifferenz in Minuten eingeben" & vbCrLf _
_
& "Für 200 Einzelschritte ist Wert = " & a & vbCrLf & "Dieser sollte nicht unterschritten _
werden!", _
Title:="Diagramm erzeugen", Default:=1#, Type:=1)
If Differenz = False Then Exit Sub
If Differenz > 0 Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Cells(myRow, myCol)
If IsNumeric(.Value) Then
If .Value > 0 And CLng(.Value) = .Value Then
Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).ClearContents
For I = 1 To CLng(.Value / Differenz)
.Offset(I, 0).Value = startWert + (I - 1) * Differenz
Next
End If
End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Else
MsgBox "Eingegebene Zahl muss > 0 sein"
End If
Dim myChart As Chart
Const diagName = "Temperaturverlauf_Tempsystem" ' den hier anpassen
' Formel in V379 bzw. W379 bis Ende löschen
Range(Cells(379, 22), Cells(Rows.Count, 22).End(xlUp)).ClearContents
Range(Cells(379, 23), Cells(Rows.Count, 23).End(xlUp)).ClearContents
Range(Cells(379, 24), Cells(Rows.Count, 24).End(xlUp)).ClearContents
Range(Cells(379, 25), Cells(Rows.Count, 25).End(xlUp)).ClearContents
Range(Cells(379, 26), Cells(Rows.Count, 26).End(xlUp)).ClearContents
' Formel eintragen
With Range(Cells(378, 21), Cells(Rows.Count, 21).End(xlUp))
'=EXP((-U378*60*$Z$289*$Z$292*$Z$297)/($Z$290*$Z$291*$Z$296))*($Z$286-$Z$287-((($C$23*$ _
_
C$8+$C$36)*$Z$296)/($Z$297*$Z$289*$Z$292)))+$Z$287+((($C$23*$C$8+$C$36)*$Z$296)/($Z$297*$Z$289*$ _
Z$292))
.Offset(0, 1).FormulaR1C1 = "=EXP((-RC[-1]*60*R289C26*R292C26*R297C26)/(R290C26*R291C26* _
_
R296C26))*(R286C26-R287C26-(((R23C3*R8C3+R36C3)*R296C26)/(R297C26*R289C26*R292C26)))+R287C26+((( _
R23C3*R8C3+R36C3)*R296C26)/(R297C26*R289C26*R292C26))"
'=V378-273,15
.Offset(0, 2).FormulaR1C1 = "=RC[-1]-273.15"
'=(($Z$287-V378)/$Z$296+V378)-273,15
.Offset(0, 3).FormulaR1C1 = "=((R287C26-RC[-2])/R296C26+RC[-2])-273.15"
'=($C$15)
.Offset(0, 4).FormulaR1C1 = "=(R15C3)"
'=ABS(($Z$294*$Z$295)*(X378-$Y$378)/LN((W378-$Y$378)/(W378-X378)))/1000
.Offset(0, 5).FormulaR1C1 = "=ABS((R294C26*R295C26)*(RC[-2]-R378C25)/LN((RC[-3]-R378C25) _
_
/(RC[-3]-RC[-2])))/1000"
' Testen, ob das Diagramm schon vorhanden ist
On Error Resume Next
Set myChart = Sheets(diagName)
' Wenn nicht, dann erzeugen
If Err.Number 0 Then
Set myChart = Charts.Add
With myChart
.Name = diagName
.ChartType = xlXYScatterSmooth
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Zeit [min]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Temperatur [°C]"
.HasLegend = False
myChart.HasTitle = True
End With
End If
myChart.SetSourceData Source:=Union(.Offset(0, 0), .Offset(0, 2), .Offset(0, 3), . _
Offset(0, 4), .Offset(0, 5)), PlotBy:=xlColumn
myChart.SeriesCollection(1).Name = "=""Behältertemperatur [°C]"""
myChart.SeriesCollection(2).Name = "=""Rücklauftemperatur [°C]"""
myChart.SeriesCollection(3).Name = "=""Vorlauftemperatur [°C]"""
myChart.SeriesCollection(4).Name = "=""Leistung [kW]"""
End With
Charts("Temperaturverlauf_Tempsystem").Select
End Sub
Anzeige