Afficher des images en ligne

Bonsoir à tous,

Avec le code ci-dessous je peux afficher des images dans une colonne d'excel en fonction d'une référence.

J'ai besoin de faire la même chose mais, cette fois sur une même ligne afin d'afficher les images au-dessus de ces références.

Le USF permet de choisir la position des références dans la feuille et le positionnement des images à insérer.

Avez-vous des idées ? J'ai cherché sans trouver la réponse.

Pour info le code je l'ai trouvé sur le net et arangé pour qu'il fonctionne selon mes besoins.

Merci

Public ImagePath As String
Public ColumnDisplay As Integer
Public ColumnRef As Integer
Public NumberOfImageToDisplay As Integer
Public Ext As String

Sub DisplayImage()

    Dim reference As String
    Dim ObjFile As Object
    Dim fso As Object
    Dim ObjDir As Object
    Dim Pic As shape
    Dim lngTop As Double
    Dim lngLeft As Double
    Dim Shp As shape

    Dim Picture As Integer
    Dim i As Integer
    Dim MyAnswer As String
    Dim hgt As Integer

    Dim MyUserForm As DisplayImageForm

''''''''''''''''''' Call UserForm '''''''''''''''''''''''''''''''''
    Set MyUserForm = New DisplayImageForm
    MyUserForm.Show
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ImagePath = ImagePath & "/"

    For Each Shp In ActiveSheet.Shapes
        If Shp.Type = msoPicture Then Shp.Delete
    Next Shp

    lngLeft = 0
    lngTop = 0

'''''''''''''''''''''''''''''' Display Visual '''''''''''''''''''''''''''''''''''''''''
        MyAnswer = MsgBox("Do you want to display pictures?", vbYesNo)
        If MyAnswer = vbNo Then
            Exit Sub
        Else
            For i = 1 To NumberOfImageToDisplay + 1
                Cells(i, ColumnRef).Select
                reference = Right(Selection.Value, 8)

                If reference = "Reference" Or reference = "" Then
                Else
                    Cells(i, ColumnDisplay).Select
                    hgt = Selection.Height
                    lngLeft = Cells(i, ColumnDisplay).Left
                    On Error Resume Next
                        Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=ImagePath & reference & "." & Ext, _
                        linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=lngLeft, Top:=lngTop, Height:=-1, Width:=-1)
                        With Pic
                            .LockAspectRatio = msoCTrue
                            .Height = hgt
                            .Left = lngLeft + (Cells(i, ColumnDisplay).Width - .Width) / 2
                        End With
                    On Error GoTo 0
                End If
                lngTop = Cells(i, ColumnDisplay).Height + lngTop
            Next
        End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Bonjour,

C'est une très mauvaise idée d'utiliser la méthode shp.Delete conjointement avec AddPicture dans cette situation :

On abouti régulièrement très rapidement à des classeurs de plusieurs Mo qui plantent tout aussi régulièrement...

Utilise LoadPicture("") et LoadPicture("blabla.jpg")

A+

Bonjour,

Merci pour le conseil je vais changer cela dans mon code !
Avez-vous une idée pour adapter le code pour qu'il fonctionne sur les lignes d'Excel ?

Je peux fournir un fichier si vous le souhaitez.

Merci beaucoup