Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
202 internautes nous ont dit merci ce mois-ci
Dim Fichier As Variant Private Sub CommandButton1_Click() Fichier = Application.GetOpenFilename( _ "Fichiers Image (*.jpg;*.gif;*.png;*.tif;*.bmp),*.jpg;*.gif;*.png;*.tif;*.bmp") If Fichier = False Then Exit Sub Range(Textcellule).Select Textcellule.Value = Textname ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Fichier, TextToDisplay:=Textcellule.Value End Sub
Declare Function GetFileTitleA Lib "Comdlg32" _ (ByVal lpszFile As String, ByVal lpszTitle As String, _ ByVal cbBuf As Long) As Long Dim I As Integer Dim cheminfichier As String Dim nom As String Sub ListFiles() 'Quel répertoire? Directory = ChoisirDossier 'Récupérez les fichiers On Error Resume Next With Application.FileSearch .NewSearch .LookIn = Directory .Filename = "*.*" 'mettre l'extension si on le désire If UserForm1.CheckBox1 = True Then .SearchSubFolders = True 'avec sous-dossier Else .SearchSubFolders = False 'sans sous-dossier End If .Execute ' Donnez les informations du fichier For I = 1 To .FoundFiles.Count cheminfichier = .FoundFiles(I) nom_fichier Range("A" & I).Select 'sélectionne la colonne, on peut changer ActiveCell.FormulaR1C1 = nom & I ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=cheminfichier, SubAddress:= _ cheminfichier & I & "!A1", TextToDisplay:=nom & I r = r + 1 Next I End With End Sub Sub nom_fichier() s$ = cheminfichier If s = "" Then Exit Sub nom = NomFich(s) End Sub Function NomFich(chemin As String) As String Dim cbBuf As Long cbBuf = GetFileTitleA(chemin, vbNullString, 0) NomFich = Space$(cbBuf) GetFileTitleA chemin, NomFich, cbBuf End Function Function ChoisirDossier() Dim objShell, objFolder, chemin As String, SecuriteSlash Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&) On Error Resume Next chemin = objFolder.Items.Item.path SecuriteSlash = InStr(objFolder.Title, ":") If SecuriteSlash > 0 Then chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & "" End If ChoisirDossier = chemin End Function
Private Sub CommandButton1_Click() ListFiles End Sub