1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
| Option Explicit
'---------------------------------
'Afficher les images d'un répertoire dans un WebBrowser
'---------------------------------
'Sélectionnez un répertoire contenant des images .jpg
'La procédure crée ensuite une page html temporaire pour visualiser
'les images contenues dans ce dossier.
'* Une option permet de créer une infobulle qui renvoie
'Le nom , la taille et la date de création de chaque image.
'* Cliquez sur la miniature pour l'afficher en plein écran.
'Placez un WebBrowser (Navigateur Web Microsoft) nommé WebBrowser1 et
'un CommandButton nommé CommandButton1 dans l'UserForm.
'---------------------------------
Private Const Planche As String = "C:\BrowserImage.html"
Private Sub CommandButton1_Click()
Dim objShell As Object, objFolder As Object
Dim i As Integer
Dim Fichier As String, S As String, X As String, Chemin As String
Dim ProprietesImages As String
'---
'Nécéssite d'activer la référence "Microsoft Scripting RunTime"
'---
Dim Fso As Scripting.FileSystemObject
Dim FileItem As Scripting.File
If Dir(Planche) <> "" Then Kill Planche
'--- selectionnez un répertoire contenant des images JPG
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un répertoire", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then Chemin = ""
i = InStr(objFolder.Title, ":")
If i > 0 Then Chemin = Mid(objFolder.Title, i - 1, 2) & ""
If Chemin = "" Then
WebBrowser1.Navigate "about:blanck"
Exit Sub
End If
'------------------------------------------------------
'Boucle sur les images jpg dans le répertoire sélectionné
Fichier = Dir(Chemin & "\*.jpg")
Set Fso = CreateObject("Scripting.FileSystemObject")
'creation de la page html qui s'affichera dans le WebBrowser
Open Planche For Output As #1
Print #1, "<HTML>"
Print #1, "<HEAD>"
Print #1, "<TITLE>" & Chemin & "</TITLE>"
Do
S = Chemin & "\" & Fichier
Set FileItem = Fso.GetFile(S)
'Pour gérer les apostrophes éventuelles dans le nom des fichiers image
S = Replace(S, "'", "'")
ProprietesImages = Replace(ProprietesImages, "'", "'")
'---------------------------------------------------------------------
'création infobulle
ProprietesImages = FileItem.Name & vbLf & FileItem.DateCreated _
& vbLf & Format(FileItem.Size, "#,##0") & " octets"
'création vignette et lien hypertexte pour chaque image
X = "<A href='" & S & "'><IMG WIDTH=70 HEIGHT=70 SRC='" & S & _
"'ALT='" & ProprietesImages & "'></IMG></A>"
Print #1, X
Fichier = Dir
Set FileItem = Nothing
Loop Until Fichier = ""
Close #1
'Affiche la page HTML dans le WebBrowser
WebBrowser1.Navigate Planche
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'suppression page html lors fermerture USF
If Dir(Planche) <> "" Then Kill Planche
End Sub |
