XL 2013 Afficher Image en fonction TextBox

F

F_Lyaa

Guest
Bonjour,
J’ai un userform avec comme entrée une liste déroulante dans laquelle je désigne une valeur.
Le contenu des cases est généré en fonction. Je bloque actuellement sur la génération d’une image en fonction de la valeur d’une case.

En fait à la valeur 1 de cette case j’associe une Image 1, à la valeur 2 de cette case j’associe une Image 2. En sachant que toute les images se trouvent dans une autre feuille excel.

Je voudrais à terme que lorsque la valeur de cette case soit 1, dans l’imagine box s’affiche l’image 2.
Est ce possible possible ? Si oui quelqu’un peut il me guider dans la création du code ?

merci par avance pour l’aide et les différentes suggestions !
 
Solution
Bonjour F_Lyaa, sylvanu, le forum,

Le fichier du post #5 ne fonctionne pas chez moi avec Excel 2019 64 bits.

Mais insérer une image dans un UserForm est très classique, pas besoin d'API Windows.

Voyez le fichier joint et le code de l'UserForm :
VB:
Private Sub NoFlacon_Change()
Dim i As Variant, s As Shape, fichier$
With Sheets("Feuil1")
    i = Application.Match(Val(NoFlacon), .[A:A], 0)
    If IsError(i) Then
        Fournisseur = "": Nom = "": Lot = "": Avertissement = ""
        Image1.Picture = LoadPicture("")
    Else
        Fournisseur = .Cells(i, 2)
        Nom = .Cells(i, 3)
        Lot = .Cells(i, 4)
        Avertissement = .Cells(i, 5)
        For Each s In Sheets("Picto").Shapes
            If s.Name = Avertissement Then...

job75

XLDnaute Barbatruc
Bonjour F_Lyaa,
En fait à la valeur 1 de cette case j’associe une Image 1, à la valeur 2 de cette case j’associe une Image 2.
[...]
Je voudrais à terme que lorsque la valeur de cette case soit 1, dans l’imagine box s’affiche l’image 2.
Il semble qu'il y ait une légère contradiction non ? Sinon faut être plus clair(e).

Et joignez votre fichier sans données confidentielles, ce n'est pas à nous de le créer !!!

A+
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour F_Lyaa, Job,
En fouillant un peu, j'ai trouvé ce fil intéressant :
Je l'ai un peu bidouillé pour l'adapter. Toutes les images sont dans la feuille Images.
Ca donne cette PJ.
 

Pièces jointes

  • test macro stock bis 3 (F_Lyaaa images).xlsm
    92.6 KB · Affichages: 23
F

F_Lyaa

Guest
Bonsoir !

Merci pour vos retours.
Voici en pj mon fichier exemple pour le test avant application sur le fichier final.
Pour une explication plus claire, quand je sélectionne un numéro de flacon, le fournisseur, nom etc apparaissent. (grâce à l'aide de Sylvanu)

La dernière case correspond à l'avertissement, ce que j'aimerai c'est qu'en fonction de cette "valeur", l'image du pictogramme associé apparaisse dans le cadre.
A savoir que les pictogrammes se situent sur une autre feuille.

Sylvanu, je pense que la méthode dans le fichier joint à votre réponse peut fonctionner.
Je vais essayer.. ca va me prendre un certain temps pour adapter ce code vu que je débute ! Merci encore :)
 

Pièces jointes

  • test stock avec image.xlsm
    48.7 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonjour F_Lyaa, sylvanu, le forum,

Le fichier du post #5 ne fonctionne pas chez moi avec Excel 2019 64 bits.

Mais insérer une image dans un UserForm est très classique, pas besoin d'API Windows.

Voyez le fichier joint et le code de l'UserForm :
VB:
Private Sub NoFlacon_Change()
Dim i As Variant, s As Shape, fichier$
With Sheets("Feuil1")
    i = Application.Match(Val(NoFlacon), .[A:A], 0)
    If IsError(i) Then
        Fournisseur = "": Nom = "": Lot = "": Avertissement = ""
        Image1.Picture = LoadPicture("")
    Else
        Fournisseur = .Cells(i, 2)
        Nom = .Cells(i, 3)
        Lot = .Cells(i, 4)
        Avertissement = .Cells(i, 5)
        For Each s In Sheets("Picto").Shapes
            If s.Name = Avertissement Then Exit For
        Next
        If s Is Nothing Then Image1.Picture = LoadPicture(""): Exit Sub
        fichier = ThisWorkbook.Path & "\MonImage.gif"
        '---création du fichier image gif---
        s.CopyPicture xlScreen, xlBitmap
        With s.Parent.ChartObjects.Add(0, 0, s.Width, s.Height).Chart
            While .Shapes.Count = 0 'en attente du collage
                DoEvents
                .Paste
            Wend
            .Export fichier, "GIF"
            .Parent.Delete 'supprime le graphique temporaire
        End With
        '---image de l'UserForm---
        Image1.PictureSizeMode = fmPictureSizeModeClip 'fmPictureSizeModeStretch
        Image1.Picture = LoadPicture(fichier)
        Kill fichier 'suppression du fichier image
    End If
End With
End Sub
Bon week-end.
 

Pièces jointes

  • test stock avec image(1).xlsm
    57.8 KB · Affichages: 16

patricktoulon

XLDnaute Barbatruc
bonjour @job75

selon les versions excel et la puissance du pc c'est entre la copie et le paste dans le chart qui est trop long et ça fait une image blanche

VB:
s.CopyPicture xlScreen, xlBitmap
'controler ici si les datas dans le clip correspondent au type hbitmap (2)    
' a ce jour je ne connais qu'une solution c'est l'api isclipboardavailable
With s.Parent.ChartObjects.Add(0, 0, s.Width, s.Height).Chart
            While .Shapes.Count = 0 'en attente du collage
                DoEvents
                .Paste' ici ca peut très bien coller une image blanche à partir du moment ou il y a l’entête bitmap dans les datas du clipboard
            Wend
l'api répond 1 si les data correspondent à l'image entiere
et pour peu que tu fasse des images en serie il est primordial de vider le clip sinon l'ors du 2d paste c'est la première image qui est collée

edit l'api c'est "IsClipboardFormatAvailable"
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
un petit exemple avec la gestion d'attente avec l'api sans déclaration (compatible(32/64))
VB:
Sub test()
    UserForm1.Show 0
    FicTmp = Environ("userprofile") & "\DeskTop\image.gif"
    Set s = ActiveSheet.Shapes("Cube 7")
    s.CopyPicture xlScreen, xlBitmap
    'pour ceux qui auraient un pc mou du bulbe
    Do: DoEvents:
    HpicVail = ExecuteExcel4Macro("CALL(""user32"",""IsClipboardFormatAvailable"",""JJC""," & 2 & ")")
    Loop While HpicVail = 0
    With s.Parent.ChartObjects.Add(0, 0, s.Width, s.Height).Chart
        .Paste    ' ici ca peut très bien coller une image blanche à partir du moment ou il y a l’entête bitmap dans les datas du clipboard
        .Export FicTmp, "GIF"
        .Parent.Delete    'supprime le graphique temporaire
    End With
    UserForm1.Image1.Picture = LoadPicture(FicTmp)
    Kill FicTmp
End Sub
 

patricktoulon

XLDnaute Barbatruc
sans cet api si j'utilise ton code en serie(copie de x images dans le userform )
j'ai :
soit plusieurs fois la même image
soit certaines blanches
sur excel 2013

seul 2007 est assez rapide et n'a pas besoins d'attente


après perso j'en ai une avec api sans déclaration aussi en WMF ultra rapide

demonstration

ci ça vous intéresse je vous la donne compatible (32/64)
demo6.gif
 

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 130
Membres
112 667
dernier inscrit
foyoman