XL 2013 Insertion image dans tableau via userform

rapi1207

XLDnaute Nouveau
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.
 

Pièces jointes

  • Boutique BBLM.xlsm
    273.3 KB · Affichages: 12

patricktoulon

XLDnaute Barbatruc
re
toute à l'heure en refaisant le projet de ce userform je ne me suis pas attarder sur le combostock bien que ça me titillait
un simple textbox aurait suffit puisqu'un seul item dans ce combo
lors du click sur bouton ; si vide alors "sur commande" sinon la valeur 🤔
 

GALOUGALOU

XLDnaute Accro
re patrick toulon
je pense avoir trouvé pendant la sieste, en tout cas l'image est maintenant dans le classeur, et pour le plaisir, j'ai rajouté le dimensionnement dans" Image_art", histoire que ce qui est visible dans le formulaire soit identique à l'image insérée dans le classeur. Mais bon ton esprit est tortueux pour moi, il y a peut-être quelque chose qui m'a échappé !!
cdt
 

patricktoulon

XLDnaute Barbatruc
Bonjour @GALOUGALOU
c'est bien mais j'aurais préféré que tu ne parle pas d'image et laisser les autres trouver par eux mêmes

quand au dimensionnement je pige pas tel que je l'ai donné le respect de l'aspect ratio(original) est conservé dans le controls image_Art et dans la cellule donc je ne sais pas ce que tu a fait mais si c’était pas le cas tu devais avoir un autre soucis
pour la simple et bonne raison que le controls est en mode picturesizeClip et dans la cellule avec ma fonction perso elle est conservé
d'ailleurs tu le vois bien dans ma démo animée dans le post #8

des fois je me demande a quoi ça sert que ducros se décarcasse hein !!! 🤣

1632229508086.png
 

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Accro
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
 

Pièces jointes

  • Capture lautaret 2.JPG
    Capture lautaret 2.JPG
    50.3 KB · Affichages: 8
  • Capture lautaret.JPG
    Capture lautaret.JPG
    50.9 KB · Affichages: 9

patricktoulon

XLDnaute Barbatruc
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
VB:
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
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
298 015
Messages
1 965 154
Membres
200 866
dernier inscrit
Moucat