Private Sub UserForm_Initialize()
Dim Fichier As String, S As String, X As String
'----------
'necessite d'activer la reference Microsoft Scripting RunTime
'----------
Dim Fso As Scripting.FileSystemObject
Dim FileItem As Scripting.File
Dim Tableau()
Dim m As Integer, Valeur As Integer, i As Integer
Dim z As Byte
Dim Cible As Variant
'-------------------------------------------
'repertoire du classeur contenant cette macro
Chemin = ThisWorkbook.Path
'---------------------------------------------
Fichier = Dir(Chemin & '\\*.jpg') 'liste les images jpg dans ce repertoire
ListBox1.Clear
FormatFich = '.jpg'
'--------------------------------------------------
'recuperation nom fichiers images et infos associées
Do
m = m + 1
ReDim Preserve Tableau(4, m)
Tableau(1, m) = Fichier
Tableau(2, m) = Chemin & '\\' & Fichier
S = Chemin & '\\' & Fichier
Set Fso = CreateObject('Scripting.FileSystemObject')
Set FileItem = Fso.GetFile(S)
Tableau(3, m) = FileItem.Name & vbLf & FileItem.DateCreated _
& vbLf & Format(FileItem.Size, '#,##0') & ' octets'
'--------
'gestion des apostrophes dans le nom des fichiers pour la creation
'de la page html
Tableau(2, m) = Application.WorksheetFunction.Substitute(Tableau(2, m), ''', ''')
Tableau(3, m) = Application.WorksheetFunction.Substitute(Tableau(3, m), ''', ''')
'--------
Tableau(4, m) = Left(FileItem.DateCreated, 10)
Fichier = Dir
Loop Until Fichier = ''
'----------------------------------------------------
'----------------------------------------------------
'trier les données par ordre décroissant de date
Do
Valeur = 0
For i = 1 To m - 1
If CDate(Tableau(4, i)) < CDate(Tableau(4, i + 1)) Then
For z = 1 To 4
Cible = Tableau(z, i)
Tableau(z, i) = Tableau(z, i + 1)
Tableau(z, i + 1) = Cible
Next z
Valeur = 1
End If
Next i
Loop While Valeur = 1
'-----------------------------------------------------------------
'creation de la page html qui s'affichera dans le WebBrowser
Open ThisWorkbook.Path & '\\browserImage.html' For Output As #1
Print #1, '<HTML>'
Print #1, '<HEAD>'
Print #1, '<TITLE>' & Chemin & '</TITLE>'
For i = 1 To m
'creation vignette et lien hypertexte pour chaque image
X = '<A href='' & Tableau(2, i) & ''><IMG WIDTH=70 HEIGHT=70 SRC='' & Tableau(2, i) & _
''ALT='' & Tableau(3, i) & ''></IMG></A>'
Print #1, X
ListBox1.AddItem Left(Tableau(1, i), Len(Tableau(1, i)) - 4)
Next i
Close #1
WebBrowser1.Navigate ThisWorkbook.Path & '\\browserImage.html'
End Sub