XL 2013 Insertion image dans tableau via userform

[rapi1207]

Bonsoir,

Tout d'abord, je vous remercie tous de l'aide que vous voudrez bien m'apporter.

Dans l'onglet Articles, j'ai un bouton de commande Ajouter. Quand je clique dessus, cela m'ouvre un Userform me permettant de renseigner tout un tat de chose. En cliquant sur Ajouter image, je peux mettre une image provenant de mon disque.

Jusque là, tout va bien.

Voilà maintenant ce que je n'arrive pas à faire : j'aimerai que cette image aille automatiquement dans la cellule correspondante à sa ligne et à sa colonne (Image) dans l'onglet Articles comme toutes les autres informations renseignées. J'aimerai pouvoir faire cela sans que l'utilisation du chemin d'accès de l'image car ce fichier est amené à ne pas travailler sur le même ordinateur. De plus, il faudrait que l'image soit bien attaché à la cellule pour me permettre de faire des tris et que les images suivent à chaque fois.

J'espère avoir été assez clair et d'avance merci de votre aide.

 

[patricktoulon]

deviner !!!
ben non je suis suffisamment sur de moi (et pour l'avoir tester en ajoutant plus d'une centaine de ligne avec le userform Avec image sans la petite coquille bien sur sur 2013 et 2016 )le fichier avant de le donner pour savoir que si ça va pas c'est que tu a fait quelque chose ou qu'il y a un souci avec l'insertion de picture si tu travaille sur 2019 ou 365 par exemple (cas vu très récemment insertpicture VS Addpicture)au quel cas je n'y peux rien, je fait du générique 2007/2016
en fait le code en ce qui me concerne est de niveau basique et devrait être compatible All versions Excel
voilà voilà

 

[GALOUGALOU]

re patrick toulon
et bien non il n'y a rien à deviner, (c'était une boutade pour te chambrer) et je n'ai pas de réponse (et surtout je ne remets pas en cause tes compétences en la matière, je suis très loin de pouvoir juger)
Mon action : j'ai récupéré ton fichier tel quel, je n'ai rien fait, et j'ai essayé d'inclure une photo. Elle n'est pas visible en totalité.
Ensuite j'ai modifié le code pour l'ajouter dans le classeur, et elle est toujours partielle dans le controls image_Art, mais visible en totalité dans le classeur.
mon système, excel 2016 version 32, windows 10. Je te joins deux photos du résultat sur mon ordi
cdt
galougalou

 

[patricktoulon]

a ben le mode clip ne fonctionne pas chez toi alors
c'est inquiétant ça essaie le mode zoom pour voir

 

[GALOUGALOU]

re
de retour, oui ça fonctionne avec le mode zoom, (je l'avais essayé dès le fil 17 )

 

[patricktoulon]

etonant que ton mode clip ne fonctionne pas
chez moi je met des images de toutes tailles

 

[GALOUGALOU]

Je tenterai sur d'autre ordi à l'occasion

 

[patricktoulon]

bon ben le mode zoom fonctionne aussi chez moi
la condition du tag dans le global
et on touche plus à moins que l'image soit optionnelle ça le demandeur nous le dira

Option Explicit
'code Patricktoulon
Private Sub Add_ima_Click()
    Dim fichier As Variant
    fichier = Application.GetOpenFilename("Tous les fichiers (*.jpg),*.jpg")
    If fichier = False Then Exit Sub
    With Image_art
        .Picture = LoadPicture(fichier)
        .Tag = fichier
    End With
End Sub

Private Sub Userform_initialize()

    Combogam.List = Range("Gamme_Article").Value    ' affectation de la liste gamme d'article

    Comboimp.List = Range("Tableau3").Value    'Affectation impression à la liste impression

    Combostock.List = Range("Lumiere9").Value    'Affectation stock à la liste stock

End Sub
Private Sub Add_art_Click()
'Définition des variables
    Dim SurComm, LL As Object, Pic As Shape, R As Range

    If Me.Combogam <> "" And Me.Text_art <> "" And Me.Text_ref <> "" And Me.Combostock <> "" And Image_art.Tag <> "" Then

        If Range("Tarticles").Cells(1) = "" Then    'si la premiere ligne est vide alors c'est la ligne
            Set R = Range("Tarticles").Rows(1)
        Else    'sinon on ajoute une ligne
            Set LL = Range("Tarticles").ListObject.ListRows.Add
            Set R = LL.Range
        End If
        R.EntireRow.RowHeight = 90

        SurComm = IIf(Me.Combostock = "Sur commande", Me.Combostock, Val(Me.Combostock))

        R.Value = Array(Me.Combogam, Me.Text_art, Me.Text_ref, Me.Comboimp, Me.Text_coul, "", _
                        Me.Text_taille, Me.Text_description, SurComm, "", "", Image_art.Tag)

        With Sheets("Articles")
            .Pictures.Insert (Image_art.Tag)
            Set Pic = .Shapes(.Shapes.Count)
        End With
        PlaceThePictureInCenterRange R.Cells(6), Pic, 90    'la marge c'est de 0 a 100
    Else
        MsgBox "vous avez oublié de choisir une image": Exit Sub
    End If
    ThisWorkbook.Save
    Unload New_article
f
End Sub


Sub PlaceThePictureInCenterRange(rng As Range, Obj As Variant, Optional PercentMarge As Long = 100)     'la marge exprime un pourcentage de 1 à x%
'fonction perso patricktoulon
    Dim Ratio#, Wx#, Yx#
    Wx = rng.Cells(1).MergeArea.Width * (PercentMarge / 100)
    Yx = rng.Cells(1).MergeArea.Height * (PercentMarge / 100)
    Ratio = Application.Min(Wx / Obj.Width, Yx / Obj.Height)
    With Obj
        If TypeName(Obj) = "Shape" Then .LockAspectRatio = msoTrue Else .ShapeRange.LockAspectRatio = msoTrue
        .Width = .Width * Ratio
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub

 

[GALOUGALOU]

re
en attendant d'avoir une réponse de rapid1207, je dirais que le code de patricktoulon, me plait beaucoup, et que le tarticles et le end if était une bonne blague !!!
cdt

 

[patricktoulon]

re
Bonsoir @GALOUGALOU
TArticles une bonne blague!!????
c'est moi qui ai ajouté le "T" devant
un tableau Structuré ayant le même nom qu'une feuille c'est impensable chez moi

 

[GALOUGALOU]

re
méaculpa
je n'avais pas pris le bon classeur, par contre reste un "end if" qui bloque la procédure
cdt

 

[patricktoulon]

re
oui tu a raison j'ai oublier de l'enlever