Trier une collection via un tableau de Doc's
Publié: 26 Déc 2004 à 01:13- Code : Tout sélectionner
'// Permet de trier une collection de documents
'// aDocs() : tableau contenant les documents à trier, ce tableau est une collection
'// sSort : Sur quel champ du document doit comporter le tri
'// nParmLow : borne mini (1 au premier lancement)
'// nParmHight : borne maxi
exemple d'utilisation
=====================
Dim DocFolder as NoteDocument
Dim Docs() As NotesDocument
'// exemple d'utilisation
Set DocFolder=View.GetFirstDocument
M=0
Do While Not (DocFolder Is Nothing)
M=M+1
Redim Preserve Docs(M)
Set Docs(M)=DocFolder
Print "Rangement du document n° ";M;" DT n° ";DocFolder.DT_C_Num(0)
Set DocFolder=View.GetNextDocument(DocFolder)
Loop
'// si possible à la place d'une vue passer par une collection pour alimenter le tableau, le balayage est plus rapide.
Call SortQuick(Docs(),"DT_C_Tri",1,M)
'// DT_C_TRI : est la clef de tri
'// cette clef peut être un champ caché du document comportant une formule
'// pour associer plusieurs clefs de tri, on peut concaténer les différentes clefs dans ce champ
Sub SortQuick (aDocs() As NotesDocument,sSort As String,nParmLow As Integer, nParmHigh As Integer)
Dim docCompare As NotesDocument
Dim docMid As NotesDocument
Dim docHold As NotesDocument
Dim nCalcLow As Integer
Dim nCalcHigh As Integer
Dim sSortFld As String
On Error Goto Erreur
If (nParmHigh <= nParmLow) Then
Exit Sub
End If
sSortFld = sSort
nCalcLow = nParmLow
nCalcHigh = nParmHigh
Set docMid = aDocs((nCalcLow + nCalcHigh) / 2)
Do While nCalcLow <= nCalcHigh
Set docCompare = aDocs(nCalcLow)
Do While nCalcLow < nParmHigh And docCompare.GetItemValue(sSortFld)(0) < docMid.GetItemValue(sSortFld)(0)
nCalcLow = nCalcLow + 1
Print "Tri en cours... ";nCalcLow
Set docCompare = aDocs(nCalcLow)
Loop
Set docCompare = aDocs(nCalcHigh)
Do While nCalcHigh > nParmLow And docCompare.GetItemValue(sSortFld)(0) > docMid.GetItemValue(sSortFld)(0)
nCalcHigh = nCalcHigh - 1
Print "Tri en cours... ";nCalcHigh
Set docCompare = aDocs(nCalcHigh)
Loop
If (nCalcLow <= nCalcHigh) Then
If (nCalcLow < nCalcHigh) Then
Set docHold = aDocs(nCalcLow)
Set aDocs(nCalcLow) = aDocs(nCalcHigh)
Set aDocs(nCalcHigh) = docHold
End If
nCalcLow = nCalcLow + 1
nCalcHigh = nCalcHigh - 1
End If
Loop
If (nParmLow < nCalcHigh) Then
Call SortQuick (aDocs(), sSortFld, nParmLow, nCalcHigh)
End If
If (nCalcLow < nParmHigh) Then
Call SortQuick (aDocs(), sSortFld, nCalcLow, nParmHigh)
End If
Goto Fin
Erreur:
Messagebox "Erreur n° " & Err & " - " & Error$,16,"SortQuick"
Resume fin
fin:
End Sub