Afficher images selon valeur textbox en boucle

  • Initiateur de la discussion Initiateur de la discussion GysEcxelVBA
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

GysEcxelVBA

XLDnaute Nouveau
Bonjour à tt le monde, le Forum

Voilà je voudrais faire apparaitre une image ds un controle Image sur un userform selon la valeur d'un texbox et ce en boucle en fonction de chaque nom = son image (ci-joint un bout de fichier)

Ah oui le tout sous vba excel.

Merci pr un retour bien que sur le forum j'ai vu une discussion sur le sujet mai je comprend rien.
 

Pièces jointes

Re : Afficher images selon valeur textbox en boucle

Bonjour,

Les macros dans le code de l'USF :

Code:
Private Sub ComboBox1_Change()
Dim n As Variant
n = Application.VLookup(ComboBox1, [Nom], 2, 0)
If IsError(n) Then Exit Sub
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Image " & n & ".jpg")
End Sub

Private Sub UserForm_Initialize()
'création de fichiers JPEG
Dim ob As Object
Application.DisplayAlerts = False 'si des fichiers existent déjà
For Each ob In Feuil3.Pictures 'CodeName de la feuille
  ob.CopyPicture
  With Feuil3.ChartObjects.Add(0, 0, ob.Width, ob.Height).Chart
    .Paste
    .Export ThisWorkbook.Path & "\" & ob.Name & ".jpg", "JPG"
    .Parent.Delete
  End With
Next
End Sub

Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)
'suppression des fichiers JPEG
Dim ob As Object
For Each ob In Feuil3.Pictures 'CodeName de la feuille
  Kill ThisWorkbook.Path & "\" & ob.Name & ".jpg"
Next
End Sub
Il faut recréer des fichierss JPEG à l'ouverture de l'USF.

Les noms des images doivent se terminer par 1, 2 3...

Fichier joint, à télécharger avant de tester.

A+
 

Pièces jointes

Re : Afficher images selon valeur textbox en boucle

Re,

Au lieu de créer tous les fichiers JPEG à l'ouverture de l'USF, il vaut mieux les créer à la demande :

Code:
Private Sub ComboBox1_Change()
Dim n As variant, chemin As String
On Error Resume Next
Image1.Picture = Nothing
n = Application.VLookup(ComboBox1, [Nom], 2, 0)
chemin = ThisWorkbook.Path & "\Image " & n & ".jpg"
'---création du fichier JPEG---
With Feuil3.Pictures("Image " & n) 'CodeName de la feuille
  .CopyPicture
  With Feuil3.ChartObjects.Add(0, 0, .Width, .Height).Chart
    .Paste
    .Export chemin, "JPG"
    .Parent.Delete
  End With
End With
Image1.Picture = LoadPicture(chemin)
End Sub

Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)
'suppression des fichiers JPEG
Dim ob As Object
On Error Resume Next
For Each ob In Feuil3.Pictures 'CodeName de la feuille
  Kill ThisWorkbook.Path & "\" & ob.Name & ".jpg"
Next
End Sub
Fichier (3), en fait j'ai vu qu'on peut le tester en ligne.

A+
 

Pièces jointes

Dernière édition:
Re : Afficher images selon valeur textbox en boucle

Re,

Je découvre que le poids du fichier augmente rapidement si on l'enregistre après création des fichiers JPEG.

Sans doute parce qu'on utilise des graphiques intermédiaires.

Pourtant ces graphiques sont supprimés 😕😕

Alors utilisons un nouveau document auxiliaire :

Code:
Private Sub ComboBox1_Change()
Dim n As Variant, chemin As String
Application.ScreenUpdating = False
On Error Resume Next
Image1.Picture = Nothing 'RAZ
n = Application.VLookup(ComboBox1, [Nom], 2, 0)
chemin = ThisWorkbook.Path & "\Image " & n & ".jpg"
'---création du fichier JPEG---
With Feuil3.Pictures("Image " & n) 'CodeName de la feuille
  .CopyPicture
  Workbooks.Add 'nouveau document
  With ActiveSheet.ChartObjects.Add(0, 0, .Width, .Height).Chart
    .Paste
    .Export chemin, "JPG"
  End With
  [B1].Copy [B1] 'vide le presse-papier
  ActiveWorkbook.Close False 'fermeture du document
End With
'---chargement de l'image---
Image1.Picture = LoadPicture(chemin)
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)
'suppression des fichiers JPEG à la fermeture de l'USF
Dim ob As Object
On Error Resume Next
For Each ob In Feuil3.Pictures 'CodeName de la feuille
  Kill ThisWorkbook.Path & "\" & ob.Name & ".jpg"
Next
End Sub
Fichier (4).

Edit 1 : j'ai reconstruit le fichier, il a bien maigri.

J'ai aussi redimensionné les images pour avoir un encadrement correct dans l'USF.

Edit 2 : ajouté une ligne pour vider le presse-papier.

A+
 

Pièces jointes

Dernière édition:
Re : Afficher images selon valeur textbox en boucle

Bonjour le fil, le forum,

Dans ce fichier (5) :

1) J'ai ajouté une BELLE IMAGE.

Avec une taille suffisante l'encadrement n'existe plus dans l'USF.

Pas compris pourquoi, si quelqu'un pouvait m'expliquer 😕

2) J'ai renommé les images Image_1 Image_2 Image_3 Image_4.

En effet l'espace comme séparateur posait parfois problème pour les renommer.

A+
 

Pièces jointes

Re : Afficher images selon valeur textbox en boucle

Slt,
D'abord désolé du temps de réponse pr te remercier d'avoir pris le temps de répondre à mon souci.

Par contre j'avais oublié de préciser que j'étais un débutant sorry lol !! J'ai bien lu tes codes sous VBA tenter de bien les comprendre mais il y en a qques que je ne comprend pas trop mai bon ton idée est génial ça fonctionne c'est exactement c que je veux faire pr mon projet en fonction du nom de la personne sa photo apparait.

Si tu pouvait mettre qques explication explicit en plus ds tes codes pr je comprennes mieux insi j'appndrai en mme temps

Merci par avance.
 
Re : Afficher images selon valeur textbox en boucle

Bonsoir GysEcxelVBA,

Le code n'est pas trop difficile à comprendre si l'on a bien compris le principe :

1) Pour créer une image dans l'USF il faut charger un fichier.

2) Pour créer le fichier à partir d'une image il faut :

- copier cette image dans un graphique auxiliaire (que l'on crée dans un nouveau document)

- exporter le graphique vers un fichier JPEG.

A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour