Lien Hypertext pour le tri Alphabétique ?

[Ben.K]

Bonjour a tous,

Petite question :

Je gere une enorme base article, et je souhaiterais savoir si il était possible d'intégrer une fonction 'tri -> Croissant / Décroissant" (par ordre alphabétique ou numérique) sous la forme d'un lien hypertext en tète de colone, comme on peux le trouver sur certain sites internet.

Merci d'avance.

Ben.K

 

[Le rital]

Bonjour le forum,

Voici un code qui devrait convenir

Cordialement

Le rital

METTRE LE CODE DANS UN MODULE

Sub TestListFilesInFolder()
Dim RootFolder$

' dossier à scanner
RootFolder = ChoisirDossier
If RootFolder = "" Then Exit Sub

' create a new workbook for the file list
Workbooks.Add

' add headers
With Range("A1")
.Formula = " Contenu du dossier : " & RootFolder
.Font.Bold = True
.Font.Size = 12
End With

Range("A3").Formula = "Chemin : "
Range("B3").Formula = "Nom : "
Range("C3").Formula = "Date Création : "
Range("D3").Formula = "Date Dernier Accès : "
Range("E3").Formula = "Date Dernière Modif : "

With Range("A3:E3")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With

' list all files included subfolders
ListFilesInFolder RootFolder, True

Columns("A:H").AutoFit

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
' Ole P Erlandsen (modifié fs 11/8/01)

Dim fso 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim SubFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim r As Long

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1

For Each FileItem In SourceFolder.files
' display file properties
Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = FileItem.Name
'la ligne ci-dessous ajoute le lien hypertexte
ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=FileItem.ParentFolder & "\" & FileItem.Name
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "jj/mm/aa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "jj/mm/aa"
' next row number
r = r + 1
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subfolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing

ActiveWorkbook.Saved = True

End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:\Windows\Bureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function

 

[chris]

Bonjour
Sinon il suffit que la cellule active soit dans la bonne colonne et de cliquer sur les boutons AZ ou ZA de la barre d'outils.
Chris