MichelXld,
J'ai très légèremet modifié ton exemple et cela donne ce qui suit (
en utilisant des images GIF, cela fonctionne, mais je n'ai pas pu paramétrer :
objShell.BrowseForFolder
) :
Private Sub CommandButton2_Click()
'selectionner un repertoire contenant des images JPG
Dim objShell As Object, objFolder As Object
Dim SecuriteSlash As Integer
Dim Fichier As String, S As String, X As String, CheminTemp As String
Dim ProprietesImages 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
Set objShell = CreateObject('Shell.Application') 'recuperer nom repertoire cible
Set objFolder = objShell.BrowseForFolder(&H0&, 'Choisir un répertoire', &H1&, 'H:\\CP\\PLan 2005\\Suivi\\Report')
CheminTemp = Chemin
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = '' Then Chemin = ''
SecuriteSlash = InStr(objFolder.Title, ':')
If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ''
If Chemin = '' Then
WebBrowser1.Navigate ThisWorkbook.Path & '\\browserImage.html'
Chemin = CheminTemp
Exit Sub
End If
Fichier = Dir(Chemin & '\\*.gif') 'ciblage des images gif dans ce repertoire
If Fichier = '' Then
Chemin = CheminTemp
Else
ListBox1.Clear
FormatFich = '.gif'
'--------------------------------------------------
'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 - nom fichier comprend la date (xxx_aammjj.gif)
Do
Valeur = 0
For i = 1 To m - 1
'Tri décroissant par date de création
'If CDate(Tableau(4, i)) < CDate(Tableau(4, i + 1)) Then
'Tri décroissant par non de fichier
If (Tableau(1, i)) < Tableau(1, 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 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
End If
WebBrowser1.Navigate ThisWorkbook.Path & '\\browserImage.html'
End Sub
