Option Explicit
Option Compare Text
Const Chemin As String = "C:\Temp"
Private Sub BoutonLancer_Click()
Dim fso As Object
Dim fldr As Object
Dim Files As Object
Dim oFile As Object
Dim li As ListItem
Dim c As Range
On Error GoTo ErrHandler
'Définit les entêtes de colonnes
With ListView1
With .ColumnHeaders
.Clear 'Supprime les anciens entêtes
'Ajout des colonnes
.Add , , "Nom", 200
.Add , , "Type", 85, lvwColumnLeft
.Add , , "Taille", 75, lvwColumnRight
End With
.View = lvwReport 'affichage en mode Rapport
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes complètes
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(Chemin)
Set Files = fldr.Files
For Each oFile In Files
If oFile.Name Like "*" & prescriptions.Value & "*" Then
Set li = ListView1.ListItems.Add(, , oFile.Name)
li.SubItems(1) = oFile.Type
li.SubItems(2) = Format$(oFile.Size, "0")
End If
Next
EndProc:
On Error Resume Next
Set li = Nothing
Set oFile = Nothing
Set fldr = Nothing
Set fso = Nothing
Exit Sub
ErrHandler:
MsgBox "ERROR: " & Err.Description, vbExclamation, "Error"
Resume EndProc
End Sub
'AFFICHAGE DES IMAGES dans userform après click sur Lv1
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i, Image As String
If Item <> "" Then
Item.ForeColor = IIf(Item.ForeColor = RGB(0, 0, 255), RGB(0, 0, 0), RGB(0, 0, 255))
For i = 1 To Item.ListSubItems.Count
Item.ListSubItems(i).ForeColor = Item.ForeColor
Next
End If
Item.Selected = 0
Image1.Picture = LoadPicture()
If ListView1.ListItems.Count > 0 Then
On Error Resume Next
' Pensez à créer un dossier "\Prescriptions\" avec les photos, dans le même dossier que fichier excel
Image = Chemin & "\" & ListView1.SelectedItem
Image1.Picture = LoadPicture(Image)
End If
End Sub
Private Sub UserForm_Initialize()
prescriptions.List = Feuil2.Range("A1", Feuil2.[A1000].End(xlUp)).Value
End Sub