Init listbox avec Images
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour le forum
Le classeur à 3 feuilles "Donnees" "Listing" Images"
Les logo sont dans "Images dans la colonne D
A: TxtB_Numéro1 (Identité) B: Nom de l'Image C: Chemin Images D: Images E: Si Pas Image
J'ai un soucis . Je n'arrive pas à charger l'image du client au double click de la listbox:
voilà le code:
'**** Correspond à l'initialisation de la ListBox "Référentiel" *****
Private Sub Initialise_LstB_Referentiel()
' déclarations des variables
Dim i As Integer
Dim fPath As String
Dim Image1, Image2 As String
Dim t As Byte
Sheets("Listing").Select
With LstB_Referentiel
TxtB1 = .List(.ListIndex, 0) ' Numéro de la Ligne
CmbB_Groupe_Nom = .List(.ListIndex, 1) 'Groupe de la famille
CmbB_Civilite = .List(.ListIndex, 2) ' Civilité
For t = 1 To 4 'Nom, Prénom, Entreprise, Service
Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 2)
Next t ' Fin de boucle
CmbB_Activite = .List(.ListIndex, 7) ' Activité
TxtB_Numero5 = .List(.ListIndex, 8) 'Adresse Domicile
CmbB_Code_Postal_Domicile = .List(.ListIndex, 9) ' Code Postal Domicile
CmbB_Ville_Domicile = .List(.ListIndex, 10) ' Ville Domicile
CmbB_Pays_Domicile = .List(.ListIndex, 11) 'Pays Domicile
TxtB_Numero6 = .List(.ListIndex, 12) 'Adresse Bureau
CmbB_Code_Postal_Bureau = .List(.ListIndex, 13) 'Code Postal Bureau
CmbB_Ville_Bureau = .List(.ListIndex, 14) 'Ville Bureau
CmbB_Pays_Bureau = .List(.ListIndex, 15) 'Pays Bureau
For t = 7 To 25
Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 9)
Next t
CmbB_Code_APE = .List(.ListIndex, 35) ' N° APE
TxtB_Numero26 = .List(.ListIndex, 36) ' Titulaire du Compte
TxtB_Numero27 = .List(.ListIndex, 37) ' Nom APE
CmbB_Banque = .List(.ListIndex, 38) ' Banque
For t = 28 To 35 ' Domiciliation, Code Banque, Code Guichet, N° Compte
Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 11) ' Clé RIB, Code BIC, Code IBAN, N° SS
Next t ' Fin de boucle
TxtB_Date1 = .List(.ListIndex, 47) ' Date de naissance
CmbB_Type_Contrat = .List(.ListIndex, 48) 'Type de Contrat
CmbB_Statut = .List(.ListIndex, 49) ' Statut
TxtB_Numero36 = .List(.ListIndex, 50) ' Salaire
CmbB_Groupe_Travail = .List(.ListIndex, 51) ' Coefficient
CmbB_Coefficient = .List(.ListIndex, 52) ' Groupe
CmbB_Poste = .List(.ListIndex, 53) ' Nom du Poste
TxtB_Date2 = .List(.ListIndex, 54) ' Date d'arrivée
TxtB_Date3 = .List(.ListIndex, 55) ' Date de création
TxtB_Date4 = .List(.ListIndex, 56) ' Date de modification
TxtB_Numero37 = .List(.ListIndex, 57) ' Notes
CmbB_CodeClient = .List(.ListIndex, 58) ' Code Client
TxtB_Numero38 = .List(.ListIndex, 59) ' Nom Enfant 1
TxtB_Numero39 = .List(.ListIndex, 60) ' Prénom Enfant 1
TxtB_Date5 = .List(.ListIndex, 61) ' Date de naissance E1
TxtB_Numero40 = .List(.ListIndex, 62) ' Nom Enfant 2
TxtB_Numero41 = .List(.ListIndex, 63) ' Prénom Enfant 2
TxtB_Date6 = .List(.ListIndex, 64) ' Date de naissance E2
TxtB_Numero42 = .List(.ListIndex, 65) ' Nom Enfant 3
TxtB_Numero43 = .List(.ListIndex, 66) ' Prénom Enfant 3
TxtB_Date7 = .List(.ListIndex, 67) ' Date de naissance E3
TxtB_Images = .List(.ListIndex, 68) ' N° de l'image
TxtB_Chemin = .List(.ListIndex, 69) ' Chemin de l'image
TxtB_Numero36 = Format(TxtB_Numero36.Value, "## ##0.00€")
TxtB_Numero1.SetFocus
End With
' Définir le chemin de fichier
fPath = ThisWorkbook.Path & "\" & TxtB_Numero1.Value
i = Me.LstB_Referentiel.ListIndex
On Error Resume Next
' Afficher l'image
If Image1 <> "" Then ' ........Dir(Fichier) <> "" Then OU If Me.Image1.Picture Is Nothing Then
With Sheets("Images")
' Si le fichier existe, il est chargé pour visualisation.
Image1.Picture = LoadPicture(TxtB_Numero1.Value & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff")
Me.Image1.Visible = True ' Affiche Image1
Me.Image2.Visible = False ' Masque Image2
'Image1.Picture = LoadPicture(fPath & "\" & Me.LstB_Referentiel.Column(3, i) & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff")
' (Fichier)
End With
Else ' Si l'image des contacts ne sont pas disponibles
With Sheets("Images")
Me.Image2.Picture = Sheets(5).PasImages.Picture ' Charge PasImages dans l'Image2
Me.Image2.Visible = True ' Affiche Image2
Me.Image1.Visible = False ' Masque Image1
End With
End If
' Gestionnaire d'erreurs reset
On Error GoTo 0
CmdB_Supprimer.Enabled = True ' Bouton dévérouillé
CmdB_Nouveau.Enabled = False ' Bouton vérouillé
CmdB_Modifier.Enabled = True 'Bouton dévérouillé
End SubMerci
Cordialement
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
bonjour le fil
voilà ce que je n'arrive pas à concrétiser
Dim fPath As String
Dim Image1, Image2 As String
' Définir le chemin de fichier
fPath = ThisWorkbook.Path & Application.PathSeparator & TxtB_Numero1.Value
i = Me.LstB_Referentiel.ListIndex
On Error Resume Nextc'est ici :
Image1.Picture = LoadPicture(name)
' Afficher l'image
If Image1 <> "" Then ' .......Dir(Fichier) <> "" Then OU If Me.Image1.Picture Is Nothing Then
With Sheets("Images")
' Si le fichier existe, il est chargé pour visualisation.
'Image1.Picture = LoadPicture(fPath)
Image1.Picture = LoadPicture(TxtB_Numero1.Text & Wsi.Range("D" & Application.Rows.Count).End(xlUp) & ".jpg")
'Image1.Picture = LoadPicture(TxtB_Numero1.Text & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff")
Me.Image1.Visible = True ' .......................Affiche Image1
Me.Image2.Visible = False ' ......................Masque Image2
'Image1.Picture = LoadPicture(fPath & "\" & Me.LstB_Referentiel.Column(3, i) & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff") ' (Fichier)
End With
Else ' ...................................................Si l'image des contacts ne sont pas disponibles
With Sheets("Images")
Me.Image2.Picture = Sheets(5).PasImages.Picture ' Charge PasImages dans l'Image2
Me.Image2.Visible = True ' .......................Affiche Image2
Me.Image1.Visible = False ' ......................Masque Image1
End With
End If
' ...............................................................Gestionnaire d'erreurs resetles images sont dans la colonnes D de la feuille n°5 sous le nom Images
Wsi.Range("D" & Application.Rows.Count).End(xlUp)
merci
Cordialement
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
bonjour le forum
Je fais un ptit rappel car je n'ai toujours pad trouvé la solution.
J'ai consulté tout ce que je pouvais et impossible de comprendre pourquoi l'image ne charge pas.
Que ce soit l'image1 et image2
If Image1 <> "" Then ' ........Dir(Fichier) <> "" Then OU If Me.Image1.Picture Is Nothing Then
With Sheets("Images")
' .....................................................................................Si le fichier existe, il est chargé pour visualisation.
Me.Image1.Picture = LoadPicture(ThisWorkbook.Path & TxtB_Numero1.Value)
'Image1.Picture = LoadPicture(fPath & "\" & Me.LstB_Referentiel.Column(3, i) & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff") ' (Fichier)
' Me.Image1.Picture = LoadPicture(strFileName)
' Me.Image1.Picture = LoadPicture(Sheets(5).TxtB_Numero1.Value)
Me.Image1.Visible = True ' .....................................................Affiche Image1
Me.Image2.Visible = False ' ....................................................Masque Image2
End With
Else ' .................................................................................Si l'image des contacts ne sont pas disponibles
With Sheets("Images")
Me.Image2.Picture = Sheets(5).PasImages.Picture ' ..............................Charge PasImages dans l'Image2
Me.Image2.Visible = True ' .....................................................Affiche Image2
Me.Image1.Visible = False ' ....................................................Masque Image1
End With
End Iffaut il que je change mon approche mais si je dois prendre les images dans un dossier j'aurai tous à recommencer.
je joins mon fichier au cas ou
merci d'avance
cordialement