Re : Télécharger une image
bonjour,
je crois que j'ai ce qu'iol te faut :
j'ai un explorer pour aller chercher le dossier de photos
puis la listes des photos se mettent dans une colonne
puis dans mon userform quand je clique sur une des photos de la list box, elle s'affiche .
Est-ce que c'est ça que tu veux ?
dans un module :
'Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
' bInfo est déclaré en tant que BrowseInfo, donc après, pour l'utiliser _
c'est bInfo. et après le point les variables déclarées dans le type apparaissent
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
' attribution d'une valeur nulle
bInfo.pidlRoot = 0&
' si msg (en paramètre) ne contient rien, on affiche ce titre
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
' on appelle l'explorateur de dossier, avec en param les infos de bInfo, et _
on enregistre le retour ID dans x
X = SHBrowseForFolder(bInfo)
path = Space$(512)
'la on récupère le chemin sélectionné
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
' on place le chemin dans la cellule X1
Range("x1") = GetDirectory
Else
GetDirectory = ""
End If
End Function
'Appel a la procedure :
Sub appel()
Msg = "Selection de la directory desire"
'change le répertoire courant en récupérant l'info dans la fonction GetDirectory, donc là rdv à GetDirectory
ChDir GetDirectory(Msg)
End Sub
Sub RecupNomFichier(ByVal Chemin As String, ByRef Tableau As Variant)
Dim Fichier As String
Dim Compteur As Integer
Dim LigneCompteur As Integer
' récupère le chemin depuis X1
Chemin = Range("x1")
Chemin = Chemin + "\*.*"
Compteur = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
' récupère le nom du premier fichier contenu dedans
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
' a l'aide d'une boucle tous les noms de fichiers contenus dans le répertoire _
sont placés dans la colonne Z
ReDim Preserve Tableau(Compteur)
Tableau(Compteur - 1) = Fichier
LigneCompteur = Compteur + 1
ActiveSheet.Range("z" & LigneCompteur).Value = Tableau(Compteur - 1)
Compteur = Compteur + 1
Fichier = Dir()
Loop
End Sub
Sub RecupFichierTableau()
Application.ScreenUpdating = False
On Error Resume Next
Dim Tableau() As String
Call RecupNomFichier(Chemin, Tableau)
FiltreAlpha
End Sub
Sub Imprim()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
Sub FiltreAlpha()
Columns("z:z").Select
Selection.Sort Key1:=Range("x2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
End With
With Selection
.HorizontalAlignment = xlRight
.Orientation = 0
End With
Range("z1").Select
End Sub
dans le code de l'userform :
Private Sub ComboBox1_Change()
nom = Me.ComboBox1.Value
On Error Resume Next
Chemin = [x1]
Fichier = Chemin & "\" & nom
Me.Image1.Picture = LoadPicture(Fichier)
End Sub
Private Sub CommandButton1_Click()
Call appel
End Sub
Private Sub CommandButton2_Click()
Call RecupFichierTableau
End Sub
Private Sub CommandButton3_Click()
' Efface les données de la plage de données de la liste des photos
Range("z1:z10000").ClearContents
Range("z1").Select
End Sub
Private Sub UserForm_Initialize()
' Initialisation de la liste de la ComboBox1
ComboBox1.RowSource = "z1:z" & ActiveSheet.UsedRange.Rows.Count
' Sélection de l'index 1 de la liste
ComboBox1.ListIndex = 0
End Sub
Si cela peut t'intéresser :
Seul petit probléme que je n'arrive pas à comprendre donc à régler
-c'est que si je fais un test avec un dossier de 50 photo, iol va me copier les nom dans la colonne Z, mais il ne démarera pas forcément à la ligne 1
De plus si j'efface et que je recommence, il ira coller la liste après la dernière ligne du précédent essai.
Moi ce que je voudrais, que ça colle la liste à partir de la 1ère cellule vide, donc la 1 s'il n'y a ruien. Dans le code, il y a la possibilité de coller après la dernière cellule non vide dans le cas où j'ai déjà un bout de liste.
Si cela peut t'aider
Cordialement
Hidozo
je suis loin d'être un expert, mais j'avais trouvé ça sur un forum et je l'ai adapté.
