Sub AfficherTempsTotaux()
Dim l_l_i As Long
Dim l_l_nbItems As Long
Dim l_o_selection As Outlook.Selection
Dim l_l_totalWorkSum As Long
Dim l_l_actualWorkSum As Long
Dim l_l_totalWork As Long
Dim l_l_actualWork As Long
Dim l_s_text As String
Dim l_o_dicoTotalWorkValues As Object 'Scripting.Dictionary
Dim l_o_dicoActualWorkValues As Object 'Scripting.Dictionary
Set l_o_selection = Application.ActiveExplorer.Selection
If l_o_selection.Count >= 0 Then
Set l_o_dicoTotalWorkValues = CreateObject("Scripting.Dictionary")
Set l_o_dicoActualWorkValues = CreateObject("Scripting.Dictionary")
For l_l_i = 1 To l_o_selection.Count
l_l_totalWork = 0
l_l_actualWork = 0
On Error Resume Next
l_l_totalWork = l_o_selection.Item(l_l_i).PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81110003")
l_l_actualWork = l_o_selection.Item(l_l_i).PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81100003")
On Error GoTo 0
If (l_l_actualWork + l_l_totalWork) > 0 Then
l_l_nbItems = l_l_nbItems + 1
l_l_totalWorkSum = l_l_totalWorkSum + l_l_totalWork
l_l_actualWorkSum = l_l_actualWorkSum + l_l_actualWork
l_o_dicoTotalWorkValues.Add l_o_dicoTotalWorkValues.Count, l_l_totalWork
l_o_dicoActualWorkValues.Add l_o_dicoActualWorkValues.Count, l_l_actualWork
End If
Next l_l_i
If l_l_nbItems = 0 Then
MsgBox "Aucun élément sélectionné n'a de temps de travail défini.", vbInformation, "Détail des tâches"
Else
l_s_text = l_l_nbItems & " élément(s) sélectionné(s) a/ont des temps de travail définis :"
l_s_text = l_s_text & vbNewLine & " - Temps total : " & l_l_totalWorkSum & " - médiane = " & CalculateMedian(l_o_dicoTotalWorkValues.Items())
l_s_text = l_s_text & vbNewLine & " - Temps réel : " & l_l_actualWorkSum & " - médiane = " & CalculateMedian(l_o_dicoActualWorkValues.Items())
MsgBox l_s_text, vbInformation, "Détail des tâches"
End If
Else
MsgBox "Aucun élément sélectionné.", vbExclamation, "Détail des tâches"
End If
Set l_o_selection = Nothing
End Sub
'https://www.piger-lesmaths.fr/comment-calculer-la-mediane/
Private Function CalculateMedian(l_av_numValues) As Double
Dim l_l_i As Long
Dim l_l_j As Long
Dim l_l_nbValues As Long
Dim l_ad_sortedValues() As Double
Dim l_d_tmpVal As Double
'copier les valeurs
ReDim l_ad_sortedValues(LBound(l_av_numValues) To UBound(l_av_numValues))
For l_l_i = LBound(l_av_numValues) To UBound(l_av_numValues)
l_ad_sortedValues(l_l_i) = CDbl(l_av_numValues(l_l_i))
Next l_l_i
'trier les valeurs
For l_l_i = LBound(l_ad_sortedValues) To UBound(l_ad_sortedValues) - 1: For l_l_j = l_l_i + 1 To UBound(l_ad_sortedValues)
If l_ad_sortedValues(l_l_j) < l_ad_sortedValues(l_l_i) Then
l_d_tmpVal = l_ad_sortedValues(l_l_j)
l_ad_sortedValues(l_l_j) = l_ad_sortedValues(l_l_i)
l_ad_sortedValues(l_l_i) = l_d_tmpVal
End If
Next l_l_j, l_l_i
'calculer la médiane
l_l_nbValues = UBound(l_ad_sortedValues) - LBound(l_ad_sortedValues) + 1
If (l_l_nbValues Mod 2) = 0 Then
CalculateMedian = (l_ad_sortedValues(LBound(l_ad_sortedValues) + l_l_nbValues / 2 - 1) + l_ad_sortedValues(LBound(l_ad_sortedValues) + l_l_nbValues / 2)) / 2
Else
CalculateMedian = l_ad_sortedValues(LBound(l_ad_sortedValues) + (l_l_nbValues - 1) / 2)
End If
End Function
