Trier une collection via un tableau de Doc's

[oguruma]

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


[franckyz]

en ajoutant un cpt=0 en entete de la fonction creerTabCles eh bien meme que ca marche mieux quand on appelle la fonction plusieurs fois !!!

Bonnes fetes à tous !

/* sauvez un glaçon, mangez un pingouin */