Tri d'une collection de documents
Publié: 11 Avr 2008 à 19:59Merci à BillBock pour son code
- Code : Tout sélectionner
(Declarations)
Dim doc As NotesDocument
Dim tabClesStr() As String
Dim tabClesNum() As Double
Dim tabClesDate() As NotesDateTime
Dim tabIDs() As String
Dim cpt As Integer
Dim elem As Variant
Dim tempID As String
*********************************
Sub creerTabCles(coll As NotesDocumentCollection, itemCle As String, typeTri As String)
'détermination du type de tri
Select Case typeTri
Case "a"
Redim tabClesStr(coll.Count-1)
Case "n"
Redim tabClesNum(coll.Count-1)
Case "d"
Redim tabClesDate(coll.Count-1)
End Select
Redim tabIDs(coll.Count-1)
'remplissage du tableau des clés
Set doc = coll.GetFirstDocument
Do Until doc Is Nothing
Select Case typeTri
Case "a"
tabClesStr(cpt) = doc.GetItemValue(itemCle)(0)
Case "n"
tabClesNum(cpt) = doc.GetItemValue(itemCle)(0)
Case "d"
Set tabClesDate(cpt) = New NotesDateTime(doc.GetItemValue(itemCle)(0))
End Select
tabIDs(cpt) = doc.UniversalID
cpt = cpt+1
Set doc = coll.GetNextDocument(doc)
Loop
End Sub
***************************************************************************************************
Function triAbulles(coll As NotesDocumentCollection, itemCle As String, typeTri As String) As Variant
'extraction du tableau des clés
Call creerTabCles(coll, itemCle,typeTri)
'tri a bulles des éléments du tableau des clés
For i=coll.Count-1 To 0 Step -1
For j=1 To i
Select Case typeTri
Case "a"
If tabClesStr(j-1) > tabClesStr(j) Then
elem = tabClesStr(j-1)
tabClesStr(j-1) = tabClesStr(j)
tabClesStr(j) = elem
tempID = tabIDs(j-1)
tabIDs(j-1) = tabIDs(j)
tabIDs(j) = tempID
End If
Case "n"
If tabClesNum(j-1) > tabClesNum(j) Then
elem = tabClesNum(j-1)
tabClesNum(j-1) = tabClesNum(j)
tabClesNum(j) = elem
tempID = tabIDs(j-1)
tabIDs(j-1) = tabIDs(j)
tabIDs(j) = tempID
End If
Case "d"
If tabClesDate(j-1).TimeDifference(tabClesDate(j)) > 0 Then
Set elem = tabClesDate(j-1)
Set tabClesDate(j-1) = tabClesDate(j)
Set tabClesDate(j) = elem
tempID = tabIDs(j-1)
tabIDs(j-1) = tabIDs(j)
tabIDs(j) = tempID
End If
End Select
Next
Next
triAbulles = tabIDs
End Function
*******************************************************************************
Function triParSelection(coll As NotesDocumentCollection, itemCle As String, typeTri As String) As Variant
Dim minimum As Integer
'extraction du tableau des clés
Call creerTabCles(coll, itemCle,typeTri)
'tri par selection des éléments du tableau des clés
For i=0 To coll.Count-1
minimum = i
For j=i To coll.Count-1
Select Case typeTri
Case "a"
If tabClesStr(j) < tabClesStr(minimum) Then
minimum = j
End If
Case "n"
If tabClesNum(j) < tabClesNum(minimum) Then
minimum = j
End If
Case "d"
If tabClesDate(j).TimeDifference(tabClesDate(minimum)) < 0 Then
minimum = j
End If
End Select
Next
Select Case typeTri
Case "a"
elem = tabClesStr(minimum)
tabClesStr(minimum) = tabClesStr(i)
tabClesStr(i) = elem
Case "n"
elem = tabClesNum(minimum)
tabClesNum(minimum) = tabClesNum(i)
tabClesNum(i) = elem
Case "d"
Set elem = tabClesDate(minimum)
Set tabClesDate(minimum) = tabClesDate(i)
Set tabClesDate(i) = elem
End Select
tempID = tabIDs(minimum)
tabIDs(minimum) = tabIDs(i)
tabIDs(i) = tempID
Next
triParSelection = tabIDs
End Function