XL 2013 Afficher Image en fonction TextBox

F_Lyaa · 25 Septembre 2020

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 !

job75 · 26 Septembre 2020

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 · 25 Septembre 2020

Bonjour F_Lyaa,

F_Lyaa à dit:
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 · 25 Septembre 2020

Bonjour F_Lyaa, Job,
En fouillant un peu, j'ai trouvé ce fil intéressant :

Label dans le sens vertical

Bonjour à toutes et tous, Je cherche depuis un bon moment pour faire pivoter un Label de 90° (actuellement dans le sens horizontal) dans un UserForm, de manière que celui-ci soit dans le sens vertical. En allant dans les propriétés du Label je ni arrive pas. :( D'avance merci pour vos...

www.excel-downloads.com

Je l'ai un peu bidouillé pour l'adapter. Toutes les images sont dans la feuille Images.
Ca donne cette PJ.

F_Lyaa · 25 Septembre 2020

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

sylvanu · 25 Septembre 2020

Il suffisait de suivre l'exemple.

job75 · 26 Septembre 2020

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.

F_Lyaa · 26 Septembre 2020

Merci pour vos retours !

patricktoulon · 26 Septembre 2020

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"

patricktoulon · 26 Septembre 2020

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

job75 · 26 Septembre 2020

Bonsoir patricktoulon,

Avec la macro de mon post #6 chez moi la boucle d'attente While/Wend s'exécute 3 fois.

Sans boucle d'attente l'image obtenue est toujours blanche.

A+

patricktoulon · 26 Septembre 2020

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)

XL 2013 Afficher Image en fonction TextBox

F_Lyaa

Guest

job75

job75

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Label dans le sens vertical

Pièces jointes

F_Lyaa

Guest

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

F_Lyaa

Guest

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires