Voici une macro qui va aller lire dans la base de donnée pour compter pour les composants que vous voulez le nombre d'état différent et la durée de chaque état et vous envoie le résultat par mail.
=> Cas simple : interrupteur on/off ça donne :
Historique radiateur
Etat False : 16h:04m:35s, nb chgt : 19, moy : 00h:50m:46s
Etat True : 07h:55m:25s, nb chgt : 20, moy : 00h:23m:46s
Ce qui veut dire que sur la journée du 5 février, le radiateur était allumé presque 8h et éteint pendant 16h. En croisant cela avec la température extérieure et la température de consigne intérieure, ça permet de faire une estimation de consommation électrique.
=> Cas "moins simple" : relevé de température :
Historique température
Etat 21 : 09h:12m:06s, nb chgt : 72, moy : 00h:07m:40s
Etat 22 : 09h:42m:03s, nb chgt : 64, moy : 00h:09m:05s
Etat 23 : 02h:41m:50s, nb chgt : 27, moy : 00h:05m:59s
Ici j'ai regroupé les températures par intervalles de 1 degré (c'est paramétrable dans le code), donc on voit qu'il a fait entre 21 et 22 pendant 9h12, etc... Mon objectif c'est de voir l'impact sur la durée d'allumage des écarts de température entre période où on est absent et où on est là .
Ca peut marcher sur n'importe quel composant (du moment qu'il n'a pas trop d'états différents, c'est alors pas très lisible), le script va lister tous les états différents quels qu'ils soient.
Si ça peut servir ou donner d'autres idées
Le code :
- Code: Tout sélectionner
'***************************************************
' Macro Historique Rad:
' Envoi un mail avec le temps allumé et éteint des radiateurs
'***************************************************
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports Microsoft.VisualBasic
Imports HoMIDom
Imports System.Net.Mail
Imports System.Data
Imports System.Collections.Generic
Namespace Dynam
'Ne pas supprimer cette class
Public Class DynamicCode
'Ne pas supprimer cette function
Public Function ExecuteCode(ParamArray prmParameters() As Object) As Object
Dim Serveur As Homidom.Homidom.server
Serveur = prmParameters(0)
Try
Dim content As String
Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", " Heure: " & Serveur.GetTime)
' J'utilise des variables pour la température voulue selon les circonstances
' A retirer Ă partir d'ici si pas utile pour vous
Dim varNuit As String = Serveur.GetValueOfVariable("123456789", "TempSejourNuit")
Dim varAbs As String = Serveur.GetValueOfVariable("123456789", "TempSejourAbsent")
Dim varPresent As String = Serveur.GetValueOfVariable("123456789", "TempSejourPresent")
content = "Temps cibles = Présent : " & varPresent & " - Nuit : " & varNuit & " - Absent : " & varAbs & Chr(13) & Chr(13)
' jusqu'Ă la ligne au-dessus
' Pour chaque composant dont vous voulez l'historique, il faut indiquer ici :
' traitement_Histo( son ID, voir homidom.xml ou propriété du composant, c'est écrit tout en bas, le nom que vous voulez voir apparaitre dans le mail,
' Serveur : à laisser comme ça.
content = content & traitement_Histo("4a7a0f7f-2664-4c48-ac62-b3b711c4c783", "radiateur SĂ©jour", Serveur)
content = content & traitement_Histo("b6f84230-ddd1-4876-b60b-422364a698d4", "radiateur bureau", Serveur)
' Si les valeurs du composant sont des nombres, vous pouvez indiquer en plus un intervalle :
' pour une température, par exemple, pour avoir les températures par tranche de 1 degré
' ou la luminosité tout les 100, alors mettre 100
' Attention mettre un point Ă la place de la virgule, ex : 0.5 au besoin
content = content & traitement_Histo("c5ca569e-1b9e-482e-84b8-fc7adea03f2b", "température", Serveur, 1)
content = content & traitement_Histo("14dcee2c-42b5-443a-ac09-c0af16a42d16", "meteo", Serveur, 1)
Dim _action As HoMIDom.HoMIDom.Mail ' Pensez Ă mettre votre mail Ă la place de monmai@...
_action = New HoMIDom.HoMIDom.Mail(Serveur, Serveur.GetSMTPMailServeur("123456789"), "monmail@mondomaine.fr", "Historique radiateurs", content, Serveur.GetSMTPServeur("123456789"), Serveur.GetSMTPPort("123456789"), Serveur.GetSMTPSSL("123456789"), Serveur.GetSMTPLogin("123456789"), Serveur.GetSMTPPassword("123456789"))
_action.Send_email()
Catch ex As Exception
Serveur.Log(8, 2, "Macro VB:HistoRad", "Exception: " & ex.Message & " - " & Err.Erl)
End Try
Return "ok"
End Function
Function traitement_Histo(ByVal id As String, ByVal nom As String, ByRef Serveur As HoMIDom.HoMIDom.Server, Optional ByVal intervale As Double = 0) As String
Dim contenu As String = "Historique " & nom & Chr(13) & Chr(13)
Dim maQuery As String = "SELECT * FROM historiques WHERE device_id=""" & id & """ AND date(dateheure) >= date('now', '-2 day')"
Dim retourQuery As DataTable = Serveur.RequeteSqLHisto("123456789", maQuery)
Dim lesValeurs As List(Of histoRad) = New List(Of histoRad)
Dim minDate As System.DateTime = Now.AddDays(-10)
Dim maxDate As System.DateTime = Now.AddDays(1)
Dim etatOne As String = ""
Dim etatEnd As String = ""
For Each row As DataRow In retourQuery.Rows
' Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", "Traitement de " & row.Item(3) & " = " & row.Item(4))
If row.Item(3) > Now.Date.AddDays(-1) And row.Item(3) < Now.Date Then
lesValeurs.Add(New histoRad(row.Item(3), row.Item(4)))
' Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", "Add car date = " & row.Item(3))
End If
If row.Item(3) < Now.Date.AddDays(-1) And minDate < row.Item(3) Then
' Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", "Note min car date = " & row.Item(3))
minDate = row.Item(3)
etatOne = row.Item(4)
End If
If row.Item(3) >= Now.Date And maxDate > row.Item(3) Then
' Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", "Note max car date = " & row.Item(3))
maxDate = row.Item(3)
etatEnd = row.Item(4)
End If
Next
If etatOne = "" Then
Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", "Erreur : pas d'état de début ! ")
Else
lesValeurs.Add(New histoRad(Now.Date.AddDays(-1), etatOne))
End If
If etatEnd = "" Then
Serveur.Log(1, 2, "Macro VB:Historique Radiateurs", "Erreur : pas d'Ă©tat de fin ! ")
Else
lesValeurs.Add(New histoRad(Now.Date, etatEnd))
End If
If lesValeurs.Count = 0 Then Return nom & " : Pas de données ! "
lesValeurs.Sort()
If intervale > 0 Then
Dim valmini As Double = 0
Dim valmaxi As Double = 0
Dim lesValeursMaj As List(Of histoRad) = New List(Of histoRad)
For Each valeur As histoRad In lesValeurs
If valmini > Double.Parse(valeur.getValeur) Then valmini = Double.Parse(valeur.getValeur)
If valmaxi < Double.Parse(valeur.getValeur) Then valmaxi = Double.Parse(valeur.getValeur)
Next
For Each valeur As histoRad In lesValeurs
For i As Double = valmini To valmaxi Step intervale
If Double.Parse(valeur.getValeur) > i And Double.Parse(valeur.getValeur) < i + intervale Then
lesValeursMaj.Add(New histoRad(valeur.getDate, i.ToString))
End If
Next
Next
lesValeurs = lesValeursMaj
End If
Dim dicoValeur As New SortedDictionary(Of String, TimeSpan)
Dim dicoCpt As New Dictionary(Of String, Integer)
Dim lastDate As System.DateTime
Dim lastEtat As String = ""
maxDate = Now.AddDays(-10)
minDate = Now.AddDays(1)
For Each valeur As histoRad In lesValeurs
If dicoValeur.ContainsKey(valeur.getValeur()) = False Then
dicoValeur.Add(valeur.getValeur(), New System.TimeSpan(0))
dicoCpt.Add(valeur.getValeur(), 0)
End If
If lastEtat <> "" Then
dicoValeur(lastEtat) = dicoValeur(lastEtat) + (valeur.getDate() - lastDate)
dicoCpt(valeur.getValeur()) = dicoCpt(valeur.getValeur()) + 1
End If
lastDate = valeur.getDate()
lastEtat = valeur.getValeur
If lastDate < minDate Then
minDate = lastDate
End If
If lastDate > maxDate Then
maxDate = lastDate
End If
Next
For Each Val As String In dicoValeur.Keys
Dim moyDuree As TimeSpan = TimeSpan.FromMilliseconds((dicoValeur(Val).TotalMilliseconds / dicoCpt(Val)))
Dim moyDureeString As String = String.Format("{0:D2}h:{1:D2}m:{2:D2}s", moyDuree.Hours, moyDuree.Minutes, moyDuree.Seconds)
Dim dureeString As String = String.Format("{0:D2}h:{1:D2}m:{2:D2}s", dicoValeur(Val).Hours, dicoValeur(Val).Minutes, dicoValeur(Val).Seconds)
contenu = contenu & "Etat " & Val & " : " & dureeString & ", nb chgt : " & dicoCpt(Val) & ", moy : " & moyDureeString & Chr(13)
Next
Return contenu & Chr(13)
End Function
End Class
Class histoRad
Implements IComparable(Of histoRad)
Dim laDate As System.DateTime
Dim valeur As String
Sub New(ByVal laDate As System.DateTime, ByVal valeur As String)
Me.laDate = laDate
Me.valeur = valeur
End Sub
Public Function getValeur() As String
Return valeur
End Function
Public Function getDate() As System.DateTime
Return laDate
End Function
Public Function CompareTo(other As histoRad) As Integer _
Implements IComparable(Of histoRad).CompareTo
If laDate = other.laDate Then
Return 0
End If
If laDate < other.laDate Then
Return -1
Else
Return 1
End If
End Function
End Class
End Namespace
je voudrais faire une macro pour soustraire l'avant-dernière valeur d'un composant de la dernière, mais comme je suis nul en Vb alors j'ai laissé tombé.