Discussion :

[pascalcom]

Bonjour,
Sur un formulaire, je veux placer une photo d’un membre d’une bd.
Mon problème est que dés que je déplace mon fichier, le lien devient invalide.
Je n’arrive pas à rendre relatif le chemin.
J’ai fait plusieurs essais avec d’autres commandes mais cela reste insatisfaisant.
Où est l’erreur ?
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
----------------------------------------------
Photo par défaut
----------------------------------------------
Private Sub cmdDelete_Click()
' Bouton de commande d'effacement de la photo
 
' supprime l'adresse de la photo
Me.Photo = vbNullString
 
' affiche l'image blank.jpg
Me.imgPhoto.Picture = CurrentProject.Path & "\images\logo_UNSS_S.gif"
'Me.imgPhoto.Picture = Application.CurrentProject.Path & "\images\logo_UNSS_S.gif"
 
' redimensionne la photo
DisplayPhoto
 
End Sub
 
-----------------------------------------------------
Insertion photo
-----------------------------------------------------
 
Private Sub cmdPhoto_Click()
Dim strLink As String
 
' Gestion des erreurs
On Error GoTo Catch01
 
' récupération du chemin physique de la photo
'  par la boite de dialogue
strLink = OuvrirUnFichier(Me.Hwnd, _
                         "Sélectionner une photo pour le JO " & Me.Nom, _
                         1)
 
' si la boite renvoie une adresse non nulle
If Len(strLink) > 0 Then
    ' tentative d'affichage de la photo
    Me.imgPhoto.Picture = strLink
    Me.Photo = strLink
End If
 
DisplayPhoto
Exit Sub
 
Catch01:
Select Case Err.Number
    Case 2114
        'Cas d'un type de fichier photo non supporté ...
        '  on sort de la procédure
        MsgBox "Le format de l'image n'est supporté par le contrôle image Picture", vbCritical + vbOKOnly, "Application Photos"
        Exit Sub
    Case 2220
        'Cas d'un emplacement non valide du fichier images
        MsgBox "Le fichier image n'a pas été trouvé à l'emplacement indiqué : " & vbCrLf & _
                Me.Photo, vbCritical + vbOKOnly, "Application Photos"
        Exit Sub
    Case Else
        ' tout autre cas d'erreur
        MsgBox "Erreur inattendue : " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Application Photos"
End Select
Err.Clear
 
 
End Sub
 
Private Sub Form_Current()
' L'événement Activation (Current) se produit lorsque le focus passe à un enregistrement
'  donné pour en faire l'enregistrement en cours, ou lorsque le formulaire est
'  Actualisé ou en Actualisation.
 
' si le nom du JO est non vide : on visualise un enregistrement
'  sinon cela indique que nous sommes sur un enregistrement vierge, donc en cours de saisie.
'  Me.Caption : gère le titre du formulaire.
If Len(Me.Nom) > 0 Then
    Me.Caption = "Détails pour le JO : " & Me.Nom & " - " & Me.Prénom
Else
    Me.Caption = "Saisie d'un nouveau JO"
End If
 
' Gestion des erreurs
On Error GoTo Catch02
 
' si la photo n'est pas définie, on affiche la photo blank.jpg
If Len(Me.Photo) > 0 Then
    Me.imgPhoto.Picture = Me.Photo
Else
    Me.imgPhoto.Picture = CurrentProject.Path & "\images\logo_UNSS_S.gif"
'    Me.imgPhoto.Picture = Application.CurrentProject.Path & "\images\logo_UNSS_S.gif"
End If
 
DisplayPhoto
 
Exit Sub
 
Catch02:
Select Case Err.Number
    Case 2114
        'Cas d'un type de fichier photo non supporté ...
        MsgBox "Le format de l'image n'est supporté par le contrôle image Picture", vbCritical + vbOKOnly, "Application Photos"
        Me.imgPhoto.Picture = CurrentProject.Path & "\images\logo_UNSS_S.gif"
'        Me.imgPhoto.Picture = Application.CurrentProject.Path & "\images\logo_UNSS_S.gif"
        Me.Photo = vbNullString
    Case 2220
        'Cas d'un emplacement non valide du fichier images
        MsgBox "Le fichier image n'a pas été trouvé à l'emplacement indiqué : " & vbCrLf & _
                Me.Photo, vbCritical + vbOKOnly, "Application Photos"
        Me.imgPhoto.Picture = CurrentProject.Path & "\images\logo_UNSS_S.gif"
'        Me.imgPhoto.Picture = Application.CurrentProject.Path & "\images\logo_UNSS_S.gif"
        Me.Photo = vbNullString
    Case Else
        ' tout autre cas d'erreur
        MsgBox "Erreur inattendue : " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Application Photos"
End Select
Err.Clear
 
End Sub
 
 
Sub DisplayPhoto()
' Traitement en fonction de la taille de l'image
 
' regarde si la hauteur de l'image dépasse celle du controle Picture
If Me.imgPhoto.ImageHeight > Me.imgPhoto.Height Then
    ' met le controle en mode zoom
    Me.imgPhoto.SizeMode = 3
Else
    ' met le contrôle en mode respect de la taille originale
    Me.imgPhoto.SizeMode = 0
End If
 
' si la largeur dépasse et qu'on est en mode taille réelle ...
If (Me.imgPhoto.ImageWidth > Me.imgPhoto.Width) And (Me.imgPhoto.SizeMode) = 0 Then
    ' on met en mode zoom
    Me.imgPhoto.SizeMode = 3
End If
 
 
End Sub
 
Private Sub Photo_BeforeUpdate(Cancel As Integer)
 
End Sub
 
----------------------------------------------------------------

[micniv]

Bonjour,

Le code suivant marche bien : tu semble l'avoir essayer mais peut-être est-ce ton extension GIF qui coince, j'utilise toujours PNG ou BMP.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.imgPhoto.Picture = Application.CurrentProject.Path & "\images\logo_UNSS_S.png"