Titre du sujet : Re: Photo dans userform
par MichelXld le 10/02/2008 16:48:45
bonjour
tu peux tester cette adaptation
Private Const Fichier As String = "C:\ImageTemp.gif"
Private Const FichDrapeau As String = "C:\ImageTempDrapeau.gif"
Private Sub Liste_noms_Change()
Dim Nb As Integer
Dim Sh As Shape
'Affiche le prénom
Prénoms = Cells(Me.Liste_noms.ListIndex + 2, 2)
Application.ScreenUpdating = False
'------------------
'Supprime l'image temportaire si elle existe
If Dir(Fichier) <> "" Then Kill Fichier
Set Sh = Feuil1.Shapes(Me.Liste_noms)
Sh.CopyPicture
With Feuil1.ChartObjects.Add(0, 0, _
Sh.Width, Sh.Height).Chart
.Paste
.Export Filename:=Fichier, filtername:="GIF"
End With
'Affiche l'image dans l'UserForm
Photos.Picture = LoadPicture(Fichier)
Nb = Feuil1.ChartObjects.Count
'supprime le graphique
Feuil1.ChartObjects(Nb).Delete
DoEvents
'------------------
If Dir(FichDrapeau) <> "" Then Kill FichDrapeau
Set Sh = Feuil1.Shapes("Drapeau" & Me.Liste_noms)
Sh.CopyPicture
With Feuil1.ChartObjects.Add(0, 0, _
Sh.Width, Sh.Height).Chart
.Paste
.Export Filename:=FichDrapeau, filtername:="GIF"
End With
'Affiche l'image dans l'UserForm
Drapeaux.Picture = LoadPicture(FichDrapeau)
Nb = Feuil1.ChartObjects.Count
'supprime le graphique
Feuil1.ChartObjects(Nb).Delete
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Terminate()
'Supprime l'image temporaire si elle existe
If Dir(Fichier) <> "" Then Kill Fichier
If Dir(FichDrapeau) <> "" Then Kill FichDrapeau
End Sub
' Documente le menu déroulant
Private Sub UserForm_Initialize()
Range("A2").Select
Do While ActiveCell <> ""
Me.Liste_noms.AddItem ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Private Sub Sortie_Click()
End
End Sub
il existe d'autres solutions, notamment en utilisant le module PastePicture de Stephen Bullen
ps
évite les accentuations dans le nom de tes controles car cela peut être une source d'erreur
(Prénoms = Cells(Me.Liste_noms.ListIndex + 2, 2))
bonne soirée
michel
|
Didier FOURGEOT