par 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