Ok, folgendes:
Das Makro rennt derart schnell durch, dass zu dem Zeitpunkt an dem du die Kooefizienten abfragen willst, mitunter noch gar nichts fertig aufgefrischt wurde. (Darum sind auch alle Kooefz. gleich)
Ich hab jetzt folgendes gemacht:
#1 - Test-Prozedur umgeschrieben
Randnotiz: Sheet7 -> siehe #2
'
' Module: Damper_Booster_Curves_Chart
'
Option Explicit 'non global or non modular variables used in Subs or funcitons have to be declared by dim
Option Base 1 ' all arrays start with index 1
Public Sub TestChartRefresh()
Dim vntNameList As Variant
Dim vntName As Variant
Dim coeffA As Double
Dim coeffB As Double
vntNameList = Array("EAF-DEC-damper", "curve2", "curve1")
For Each vntName In vntNameList
Call Sheet7.GetDamperCurveTrendCoefficients(vntName, coeffA, coeffB)
Debug.Print "['"; CStr(vntName); "']:"; Tab(25); "CoeffA: " & Format$(coeffA, "0.00") & "; CoeffB: " & Format$(coeffB, "0.00")
Next
End Sub
-> liefert nach Ausführen:
['EAF-DEC-damper']: CoeffA: 420,66; CoeffB: -0,10
['curve2']: CoeffA: 512,00; CoeffB: -0,07
['curve1']: CoeffA: 149,58; CoeffB: -0,07
#2 - Alle Funktionen die die Graphen betreffen in das entspr. Blatt gepackt.
Randnotiz: Derzeit hat dieses Blatt den Codenamen "Sheet7". Ändere in ab in z.B. "tblDamperCurves" dann kannst du dieses im Makro unter jenem Namen ansprechen. Darum steht unter #1 zum ansprechen von GetDamperCurveTrendCoefficients() aktuell noch Sheet7.
'
' Sheet: "DAMPER-CURVES"
'
Option Explicit 'non global or non modular variables used in Subs or funcitons have to be declared by dim
Option Base 1 ' all arrays start with index 1
Private WithEvents Chart_NormalScaling As Excel.Chart
Private WithEvents Chart_LogarithmicScaling As Excel.Chart
Private Sub Chart_NormalScaling_Calculate()
' Debug.Print Time$, "Chart_NormalScaling_Calculate"
DoEvents 'Excel Zeit zum Denken geben
End Sub
Private Sub Chart_LogarithmicScaling_Calculate()
' Debug.Print Time$, "Chart_LogarithmicScaling_Calculate"
DoEvents 'Excel Zeit zum Denken geben
End Sub
Public Function GetDamperCurveTrendCoefficients(ByVal curveName As String, ByRef coeffA As Double, ByRef coeffB As Double)
'returns A and B coefficients by reference of a chart trendline with the form [y = A * exp(B*x)]
Set Chart_NormalScaling = ChartObjects(damperCurveNormalScaling).Chart
Set Chart_LogarithmicScaling = ChartObjects(damperCurveLogarithmicScaling).Chart
Dim currentChart As Chart
Dim fName As String 'filename
Dim formulaString As String
Dim splitA() As String
Dim SplitB() As String
'save filename
fName = ThisWorkbook.Path & "\temp.gif"
'update the chart source data to the curve with the curveName
Call SetChartData(Me, curveName, damperCurveNormalScaling, damperCurveLogarithmicScaling)
'get the exp Trendline formula as string
formulaString = Chart_NormalScaling.SeriesCollection(1).Trendlines(1).DataLabel.text
'String treatments to get coeffA and coeffB
splitA = Split(Replace(formulaString, "y = ", ""), "e")
SplitB = Split(splitA(1), "x")
'RETURN Coefficients
coeffA = splitA(0) 'return CoeffA
coeffB = SplitB(0) 'return CoeffB
End Function
Private Function LastUsedRow(ByVal Worksheet As Excel.Worksheet) As Long
'Finds the last non-blank cell on a sheet/range, if no parameter is set it will search by default in the active worksheet
Dim lRow As Long
On Error Resume Next
lRow = Worksheet.Cells.Find(What:="*", _
after:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).row
LastUsedRow = lRow
On Error GoTo 0
End Function
Private Function LastUsedColumn(ByVal Worksheet As Excel.Worksheet) As Long
'Finds the last non-blank column on a sheet/range, if no parameter is set it will search by default in the active worksheet
Dim lCol As Long
On Error Resume Next
lCol = Worksheet.Cells.Find(What:="*", _
after:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
LastUsedColumn = lCol
On Error GoTo 0
End Function
Private Function SetChartData(ByVal Worksheet As Excel.Worksheet, _
ByVal curveName As String, _
ByVal normalScalingChartName As String, _
ByVal logScalingChartName As String)
'searches for the curveName and updates both charts (normal and logarithmic scaling)
Dim i As Integer
Dim chartDataRange As Range
If curveName = "" Then
Exit Function
End If
'search for curveName and change Source for Chart-Data
For i = DAMPER_CURVES_DATA_1stROW To LastUsedRow(Worksheet)
With Worksheet
If .Cells(i, 1).value = curveName Then
Set chartDataRange = .Range(.Cells(i, DAMPER_CURVES_DATA_1stCOL), _
.Cells(i + 1, DAMPER_CURVES_DATA_1stCOL + 29)) 'data range (30 possible data pairs)
Call .ChartObjects(normalScalingChartName).Chart.SetSourceData(Source:=chartDataRange)
Call .ChartObjects(logScalingChartName).Chart.SetSourceData(Source:=chartDataRange)
Exit Function
End If
End With
Next
End Function
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
' 'a doubleclick on a name cell of the damper curves updates the chartData
'
' 'check valid range
' If Application.ActiveCell.Column = 1 _
' And Application.ActiveCell.row > DAMPER_CURVES_DATA_1stROW - 1 _
' And Application.ActiveCell.row < LastUsedRow(ActiveSheet) Then
' Call SetChartData(ActiveSheet, Application.ActiveCell.value, damperCurveNormalScaling, damperCurveLogarithmicScaling)
' Cancel = False 'don't continue after double click
' Else
' Cancel = False 'normal double click --> set courser in cell
' End If
'End Sub
Weitere Anmerkungen:
1) LastUsedRow in Spalte A:
Private Function LastUsedRow() As Long
With Sheet7
With .Cells(.Rows.Count, "A").End(xlUp)
If .MergeCells Then
LastUsedRow = .Row + .MergeArea.Rows.Count - 1
Else
LastUsedRow = .Row
End If
End With
End With
End Function
Da die Funktion in "Sheet7" liegt, könnte man dafür auch einfach Me schreiben.
2) LastUsedColumn ist analog 1).
3) In SetChartData() kannst du per Range.Find()-Methode nach dem curveName suchen und so auf die For-Schleife verzichten.
Das wars erstmal. :)
Beste Grüße
Trägheit
|