XL 2021 insertion d'image provenant d'unecellule dans un userform

[jere12nba]

Bonjour,
J'ai un fichier Excel avec des noms de pièces et la quantité requise pour un assemblage. À côté de cela, j'ai une image de chaque pièce qui n'a pas de chemin défini. Les images sont simplement insérées dans le classeur, et elles sont stockées dans la colonne D.
Lorsque je lance le UserForm, il y a une sorte de liste de contrôle où il faut vérifier si la quantité de chaque pièce requise est présente. Ensuite, je dois entrer "oui" ou "non", et cela passe à la pièce suivante à vérifier.
Pour cela, il faudrait que l'image correspondant à la pièce dans la colonne D apparaisse. J'ai un code pour cela, mais il n'arrive pas à récupérer l'image.
Merci d'avance pour votre aide.

Private Sub ChargerImage()
Dim ws As Worksheet
Dim img As Shape
Dim cell As Range
Dim chartObj As ChartObject
Dim tempFilePath As String
Dim currentRow As Long

' Définir la ligne actuelle (exemple : ligne 2)
currentRow = 2 ' Vous pouvez remplacer par la logique appropriée pour obtenir la ligne actuelle

' Référence à la feuille contenant l'image
Set ws = ThisWorkbook.Sheets("Outillage") ' Assurez-vous que "Outillage" est bien la feuille correcte
Set cell = ws.Cells(currentRow, 4) ' Colonne D pour l'exemple (modifiez si nécessaire)

' Parcourir les formes de la feuille
For Each img In ws.Shapes
' Vérifier si l'image se trouve dans la cellule D (en fonction de la ligne actuelle)
If Not Intersect(img.TopLeftCell, cell) Is Nothing Then
' Copier l'image en tant qu'image bitmap
img.CopyPicture Appearance:=xlScreen, Format:=xlPicture

' Créer un graphique temporaire pour coller l'image
Set chartObj = ws.ChartObjects.Add(Left:=0, Top:=0, Width:=img.Width, Height:=img.Height)
chartObj.Chart.Paste

' Définir un chemin temporaire pour le fichier image
tempFilePath = Environ("TEMP") & "\temp_image.jpg"
chartObj.Chart.Export Filename:=tempFilePath

' Supprimer le graphique temporaire
chartObj.Delete

' Charger l'image dans le contrôle Image1
Me.Image1.PictureSizeMode = fmPictureSizeModeZoom ' Ajuste la taille de l'image
Me.Image1.Picture = LoadPicture(tempFilePath) ' Charge l'image depuis le fichier temporaire

' Supprimer le fichier temporaire après le chargement
Kill tempFilePath

' Rendre l'image visible
Me.Image1.Visible = True

Exit For ' Sortir de la boucle après avoir trouvé l'image
End If
Next img
End Sub

 

[vgendron]

Bonjour et bienvenue

il faudrait que tu places le code entre balises vba (icone de droite en haut)==> ca le rendrait beaucoup plus lisible

ensuite.. le code tout seul, c'est bien, mais avec le fichier qui le contient, c'est mieux
1) on aurait aussi accès aux images dont tu parles
2) ca nous permettrait de visualiser et reproduire le pb que tu rencontres
3) et ca nous permet de tester la solution qu'on pourrait t'apporter

juste une note sur le fichier: il faut qu'il soit anonymisé.. pas de données confidentielles..

 

[job75]

Bonjour jere12nba, bienvenue sur XLD, [Edit] salut vgendron,

Vous parlez d'assemblage mais vous vous contentez de mettre une image dans l'UserForm.

Que voulez-vous en faire ensuite ?

A+

 

[jere12nba]

Bonjour et bienvenue

il faudrait que tu places le code entre balises vba (icone de droite en haut)==> ca le rendrait beaucoup plus lisible

ensuite.. le code tout seul, c'est bien, mais avec le fichier qui le contient, c'est mieux
1) on aurait aussi accès aux images dont tu parles
2) ca nous permettrait de visualiser et reproduire le pb que tu rencontres
3) et ca nous permet de tester la solution qu'on pourrait t'apporter

juste une note sur le fichier: il faut qu'il soit anonymisé.. pas de données confidentielles..

Merci pour votre répnonse désole je debut, il faudrait que l'image s'affiche dans le UserForm2 dans "Image1" :

Private Sub ChargerImage()
    Dim ws As Worksheet
    Dim img As Shape
    Dim cell As Range
    Dim currentRow As Long

    ' Définir la feuille et la ligne actuelle (modifie currentRow selon ton contexte)
    Set ws = ThisWorkbook.Sheets("Outillage")
    currentRow = 2 ' <-- À modifier selon ton besoin
    Set cell = ws.Cells(currentRow, 4) ' Colonne D

    ' Chercher l'image dans la cellule
    For Each img In ws.Shapes
        If Not Intersect(img.TopLeftCell, cell) Is Nothing Then
            If img.Type = msoPicture Then
                ' Copier l'image
                img.Copy
                ' Coller l'image dans le contrôle Image1
                Me.Image1.Picture = LoadPicture("") ' Efface l'ancienne image
                Me.Image1.Picture = Me.Image1.Picture
                Exit Sub
            End If
        End If
    Next img

    ' Si aucune image n'est trouvée
    MsgBox "Aucune image trouvée dans la cellule.", vbExclamation, "Erreur"
End Sub

 

[vgendron]

il y a un souci dans ton fichier..
ta macro ChargerImage n'est jamais appelée..
les boutons Précédent et Suivant n'ont pas de code..

 

[jere12nba]

il y a un souci dans ton fichier..
ta macro ChargerImage n'est jamais appelée..
les boutons Précédent et Suivant n'ont pas de code..

Voici la bonne version du fichier. merci

 

[fanch55]

Bonjour,
Code fonctionnel :

Private Sub ChargerImage()
Dim ws As Worksheet
Dim Img As Shape
Dim cell As Range
Dim tempFilePath As String
Dim currentRow As Long

    ' Définir la ligne actuelle (exemple : ligne 2)
    currentRow = 2 ' Vous pouvez remplacer par la logique appropriée pour obtenir la ligne actuelle
    
    ' Référence à la feuille contenant l'image
    Set ws = ThisWorkbook.Sheets("Outillage") ' Assurez-vous que "Outillage" est bien la feuille correcte
    Set cell = ws.Cells(currentRow, "D") ' Colonne D pour l'exemple (modifiez si nécessaire)
    
    ' Définir un chemin temporaire pour le fichier image
    tempFilePath = Environ("TEMP") & "\temp_image.jpg"
    
    ' Parcourir les formes de la feuille
    For Each Img In ws.Shapes
        ' Vérifier si l'image se trouve dans la cellule D (en fonction de la ligne actuelle)
        If Not Intersect(Img.TopLeftCell, cell) Is Nothing Then
            ' Copier l'image en tant qu'image bitmap
            Img.CopyPicture Format:=xlBitmap ' <== pour les JPG
            
            ' Créer un graphique temporaire pour coller l'image
            With ws.ChartObjects.Add(Left:=0, Top:=0, Width:=Img.Width, Height:=Img.Height)
                .Activate  ' <--- Important
                .Chart.Paste
                .Chart.Export Filename:=tempFilePath
                .Delete ' Supprimer le graphique temporaire
            End With
            
            ' Charger l'image dans le contrôle Image1
            With Me.Image1
                .PictureSizeMode = fmPictureSizeModeZoom ' Ajuste la taille de l'image
                .Picture = LoadPicture(tempFilePath) ' Charge l'image depuis le fichier temporaire
                .Visible = True
            End With
            
            ' Supprimer le fichier temporaire après le chargement
            Kill tempFilePath
            
            Exit For ' Sortir de la boucle après avoir trouvé l'image
        End If
    Next Img
End Sub

Private Sub UserForm_Initialize()
    ChargerImage
End Sub

 

[vgendron]

Hello Fanch55
j'ai beau essayer de comprendre, mais cette instruction

If Not Intersect(Img.TopLeftCell, cell) Is Nothing Then

n'est jamais vérifiée==> aucune chance de charger quoique ce soit

et meme si, en mode pas à pas, je le force à rentrer dans le if, et bah.. il ne se passe rien non plus..?

 

[vgendron]

et si je peux me permettre une remarque sur le code complet..
beaucoup de recherches et de fonctions inutiles
il suffit de connaitre la ligne de la Table Structurée (non exploitée dans le code) pour avoir tout de suite les infos de quantité, de configuration, et de premier élément...
d'ailleurs, ca mériterait d'ajouter un combo qui liste les éléments du produit

 

[vgendron]

en plus, je viens de voir que les fonctions "TrouverRow" "PremiereOccurence..... sont définies deux fois.. dans le code du formulaire ET dans un module...
pas bon..

 

[fanch55]

Hello Fanch55
j'ai beau essayer de comprendre, mais cette instruction

If Not Intersect(Img.TopLeftCell, cell) Is Nothing Then

n'est jamais vérifiée==> aucune chance de charger quoique ce soit

et meme si, en mode pas à pas, je le force à rentrer dans le if, et bah.. il ne se passe rien non plus..?

Je n'ai pas travaillé sur le dernier classeur fourni, mais sur le code initial de la demande .
J'ai laissé l'intersect existant car il fonctionne si le topleftcell de l'image est bien celui de la cellule ( ce qui n'est pas le cas avec le dernier classeur fourni )
Par ailleurs, je doute que la sub ChargerImage du dernier classeur ait jamais pu fonctionner ( surtout si on prend toujours l'image en D2) ....

 

[jere12nba]

et si je peux me permettre une remarque sur le code complet..
beaucoup de recherches et de fonctions inutiles
il suffit de connaitre la ligne de la Table Structurée (non exploitée dans le code) pour avoir tout de suite les infos de quantité, de configuration, et de premier élément...
d'ailleurs, ca mériterait d'ajouter un combo qui liste les éléments du produit

Je suis conscient qu’il y avait certainement plus facile à faire, mais comme je débute, c'est compliqué de trouver toutes les informations par soi-même.

 

[vgendron]

Je suis conscient qu’il y avait certainement plus facile à faire, mais comme je débute, c'est compliqué de trouver toutes les informations par soi-même.

Oui j'imagine, pas de souci

je dois m'absenter un peu, je reviens vers toi avec une propostion "allégée"

 

[vgendron]

Je n'ai pas travaillé sur le dernier classeur fourni, mais sur le code initial de la demande .
J'ai laissé l'intersect existant car il fonctionne si le topleftcell de l'image est bien celui de la cellule ( ce qui n'est pas le cas avec le dernier classeur fourni )
Par ailleurs, je doute que la sub ChargerImage du dernier classeur ait jamais pu fonctionner ( surtout si on prend toujours l'image en D2) ....

Exact.. ca vient de moi. et de mon coté "Psychorigide" qui n'aime pas les images non centrées... :-D ==> du coup.. par réflexe je l'ai déplacée.. et le topleft n'est plus dans la cellule

et comme le currentrow est remi à 2 systématiquement, aucune chance que les autres images soient affichées

 

[vgendron]

Une question.. le premier formulaire est indispensable??

on pourrait n'avoir qu'un seul formulaire (le 2nd) sur lequel on selectionne directement l'outillage..