Trier une colonne dans Excel

Trier une colonne dans Excel

Messagepar Michael DELIQUE » 23 Sep 2011 à 16:23

Code : Tout sélectionner
Public Sub ExcelSort(wnbTriCroissant As Boolean,wnbMatchCase As Boolean,wnbSortRow As Boolean, wobjXLSWorkSheet As Variant, wnbFistRaw As Long,wnbLastRaw As Long, wnbColumn As Long)

   Dim objXLSRange As Variant
   Dim nbSens As Integer
   Dim nbOrientation As Integer
   Const nbWithTitle = 0 
   REM nbWithTitle = 0 la premiere ligne n'est pas un titre et est trié, nbWithTitle = 1 la premiereligne est un titre et n'est pas trié

   On Error GoTo CatchError

   If TestVariant(wobjXLSWorkSheet) = False Then
      Error 9999,"wobjXLSWorkSheet is empty"
      Exit Sub
   End If

   If wnbFistRaw < 0 Then
      Error 9999,"wnbFistRaw < 0"
      Exit Sub
   End If

   If wnbLastRaw < 0 Then
      Error 9999,"wnbLastRaw < 0"
      Exit Sub
   End If

   If wnbFistRaw = wnbLastRaw Then   
      Exit Sub
   End If

   If wnbColumn < 0 Then
      Error 9999,"wnbColumn < 0"
      Exit Sub
   End If
   
   If wnbTriCroissant = True Then
      REM xlAscending = 1    "CROISSANT","C","A","ASCENDANT","ASCENDING","I","INCREASING","",">"
      
      nbSens = 1      
   else
      REM xlDescending = 2 "DECROISSANT","D","DESCENDANT","DESCENDING","DECREASING","<"
      nbSens = 2
      
   End If

   If wnbSortRow = True Then
      REM trie une ligne, xlLeftToRight = 2
      nbOrientation = 2
   Else
      REM trie une colonne, xlTopToBottom = 1   
      nbOrientation = 1
   End If

   Set objXLSRange = wobjXLSWorkSheet.Range(wobjXLSWorkSheet.Cells(wnbFistRaw,wnbColumn), wobjXLSWorkSheet.Cells(wnbLastRaw,wnbColumn))
   objXLSRange.Sort wobjXLSWorkSheet.Cells(wnbFistRaw, wnbColumn), nbSens, , , , , , nbWithTitle, 1, wnbMatchCase, nbOrientation,
   Set objXLSRange = Nothing

   Exit Sub
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Exit Sub
End Sub
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Retour vers Importation/Exportation vers d'autres applications