OBLog

Option Explicit

Function elementAngle(node1 As Integer, node2 As Integer, node3 As Integer, nodes As Range)
Dim posX1 As Double, posY1 As Double, posX2 As Double, posY2 As Double, posX3 As Double, posY3 As Double
Dim tmp
Dim scalProd As Double, norme1 As Double, norme2 As Double, angle As Double

tmp = trouveNoeud(node1, nodes, posX1, posY1)
If tmp = -1 Then MsgBox "Noeud " + node1 + " pas trouvé"
tmp = trouveNoeud(node2, nodes, posX2, posY2)
If tmp = -1 Then MsgBox "Noeud " + node2 + " pas trouvé"
tmp = trouveNoeud(node3, nodes, posX3, posY3)
If tmp = -1 Then MsgBox "Noeud " + node3 + " pas trouvé"

scalProd = (posX2 - posX1) * (posX3 - posX1) + (posY2 - posY1) * (posY3 - posY1)
norme1 = Sqr((posX2 - posX1) ^ 2 + (posY2 - posY1) ^ 2)
norme2 = Sqr((posX3 - posX1) ^ 2 + (posY3 - posY1) ^ 2)
angle = Abs((scalProd / (norme1 * norme2))) * 180 / 3.141592654

elementAngle = angle

End Function


Function trouveNoeud(node As Integer, nodes As Range, posX As Double, posY As Double)
Dim i As Integer
For i = 0 To nodes.Rows.Count
   If nodes.Cells(i + 1, 1) = node Then
      posX = nodes.Cells(i + 1, 2)
      posY = nodes.Cells(i + 1, 3)
      trouveNoeud = i
      Exit Function
   End If
Next
trouveNoeud = -1
End Function

Option Explicit

Sub GetGraphData()
'
' GetGraphData Macro
' Va chercher dans le classeur correspondant les données de la courbe sélectionnée
'

Dim n As Integer, s As String, i As Integer, j As Integer
Dim vals, r As Range, x(), y()
Dim startCell As String
Dim getIt As Integer, nomSerie As String

With ActiveChart.ChartGroups(1)
   For i = 1 To .SeriesCollection.Count
      s = .SeriesCollection(i).Formula
      s = Mid(s, InStr(s, "(") + 1)
      s = Left(s, InStrRev(s, ")") - 1)
      vals = Split(s, ",")
      If InStr(vals(0), "$") <> 0 Then
         nomSerie = Range(vals(0))
      Else
         nomSerie = vals(0)
      End If
      getIt = MsgBox("Désirez-vous prendre ces valeurs ?", vbYesNoCancel, "Série " & nomSerie)
      If getIt = vbYes Then
         RangeToVector Range(vals(1)), x()
         RangeToVector Range(vals(2)), y()
         startCell = InputBox("Cellule de départ", UBound(x) + 1 & " valeurs collectées")
         If startCell <> "" Then
            Set r = ActiveSheet.Range(startCell)
            r.Offset(0, 1) = nomSerie
            For j = 0 To UBound(x)
               r.Offset(j + 1, 0) = x(j)
               r.Offset(j + 1, 1) = y(j)
            Next
         End If
      End If
      If getIt = vbCancel Then Exit For
   Next
End With

End Sub

Sub RangeToVector(r As Range, arr())
Dim i As Integer, j As Integer, m As Integer, n As Integer
Dim maxCount As Integer
m = r.Rows.Count
n = r.Columns.Count
If m >= n Then 'vertical
   maxCount = m
Else
   maxCount = n
End If
ReDim arr(maxCount - 1)

For i = 0 To maxCount - 1
   If m >= n Then
      arr(i) = r.Cells(i + 1, 1).Value
   Else
      arr(i) = r.Cells(0, i).Value
   End If
Next
End Sub