Inserer des images + le nom du fichier ? dans tableau

Bonjours j'aimerai savoir comment my prendre.

J'ai un tableau example sur [A] [B]

Je souhaite importé tout mon dossier image dans le tableau [A]

Et que le nom de fichier soi inscrit a côté dans [B]

Donc en fait ( l 'image a la taille de la cellule dans A1, Et dans B1 le nom de fichier {example.png}

Merci pour vos conseil.

Car jai une Base de donné a faire , et je commence a trouvé cela long , j'ai plus de 350 image a faire et a lister.

Merci a vous.

Bonjour,

Voir : http://boisgontierjacques.free.fr/pages_site/lesimages.htm#ImportImages

Gelinotte

Merci.

Cependant le problème reste inchangé car j'aimerai que le nom du fichier sois par la même occasion importé automatiquement.

Pour ma part j'utilise ce script.

Il permet d'importer tous les image que je sélectionne.

Cependant je ne sais pas comment le modifier pour qu'il import dans la cellule a coté, le nom de fichier.

Je ne connait pas la syntaxe VBA, je touche seulement Javascript, PHP, HTML et CSS.

Si quelqu'un peut me sortir la formule a ajouté , ce serai gentil.

Quelqu'un a une idée des modification pour que ce code , ajoute aussi le nom de fichier dans la colonne de droite.

Sub InsertPictures()
    Dim PicList() As Variant
    Dim PicFormat As String
    Dim Rng As Range
    Dim sShape As Shape
    On Error Resume Next
    PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
    xColIndex = Application.ActiveCell.Column
    If IsArray(PicList) Then
        xRowIndex = Application.ActiveCell.Row
        For lLoop = LBound(PicList) To UBound(PicList)
            Set Rng = Cells(xRowIndex, xColIndex)
            With ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1)
                .LockAspectRatio = msoTrue
                .Height = 100 * 3 / 4
                Rng.RowHeight = .Height
                Rng.ColumnWidth = .Width / Rng.Width * Rng.ColumnWidth
                Rng.ColumnWidth = .Width / Rng.Width * Rng.ColumnWidth
                Rng.ColumnWidth = .Width / Rng.Width * Rng.ColumnWidth
            End With
            xRowIndex = xRowIndex + 1
        Next
    End If
End Sub

J'ai trouvé ma solution aproximative.

Je n'est pas pu les combiné , ne connaisant pas l'étrange syntaxe VBA.

Mais j'execute en 2 partie ces module , et jobtien mon ®esulta.

Image dans une colone, et nom fichier dans lautre colone.

Sub InsertPictures()
    Dim PicList() As Variant
    Dim PicFormat As String
    Dim Rng As Range
    Dim sShape As Shape
    On Error Resume Next
    PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
    xColIndex = Application.ActiveCell.Column
    If IsArray(PicList) Then
        xRowIndex = Application.ActiveCell.Row
        For lLoop = LBound(PicList) To UBound(PicList)
            Set Rng = Cells(xRowIndex, xColIndex)
            With ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1)
                .LockAspectRatio = msoTrue
                .Height = 100 * 3 / 4
                Rng.RowHeight = .Height
                Rng.ColumnWidth = .Width / Rng.Width * Rng.ColumnWidth
                Rng.ColumnWidth = .Width / Rng.Width * Rng.ColumnWidth
                Rng.ColumnWidth = .Width / Rng.Width * Rng.ColumnWidth
            End With
            xRowIndex = xRowIndex + 1
        Next
    End If
End Sub

Ensuite

Option Explicit 

Sub GetFileNames() 

    Dim xRow As Long 
    Dim xDirect$, xFname$, InitialFoldr$ 

    InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from

    With Application.FileDialog(msoFileDialogFolderPicker) 
        .InitialFileName = Application.DefaultFilePath & "\" 
        .Title = "Please select a folder to list Files from" 
        .InitialFileName = InitialFoldr$ 
        .Show 
        If .SelectedItems.Count <> 0 Then 
            xDirect$ = .SelectedItems(1) & "\" 
            xFname$ = Dir(xDirect$, 7) 
            Do While xFname$ <> "" 
                ActiveCell.Offset(xRow) = xFname$ 
                xRow = xRow + 1 
                xFname$ = Dir 
            Loop 
        End If 
    End With 
End Sub 

Bonjour,

J'ai adapté le code de Jacques Boisgontier ...

Les images dans la colonne A.

Les noms des images dans la colonne B.

Chaque image porte son nom.

Voir si ça convient ...

Sub ImportImages()
  ActiveSheet.DrawingObjects.Delete
  répertoirePhoto = "D:\LesImages\"  ''"c:\mesdoc\"
  nf = Dir(répertoirePhoto & "*.jpg") ' premier fichier
  Range("A1").Select    ' cellule où commence l'insertion des images
  Do While nf <> ""
    Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & nf)
    img.Top = ActiveCell.Top
    img.Left = ActiveCell.Left
    img.Height = 100 * 3 / 4
    img.Name = Left(nf, Len(nf) - 4) ' Donne un nom à l'image
    ActiveCell.Offset(0, 1) = nf      ' inscrit le nom de l'image dans la colonne à droite
    ActiveCell.EntireRow.RowHeight = img.Height + 2  '  hauteur de la cellule
    nf = Dir ' suivant
    ActiveCell.Offset(1, 0).Select  ' un ligne plus bas pour la prochaine image
  Loop
End Sub

Gelinotte

Merci impecable, je fait aussi étudier ton code pour comprendre un peu le VBA, tes super mon ami