Problème affichage photo après suppression

**ThieBEN** · 13/03/2008, 09h14

Bonjour à tous,
J'ai un frm avec des photos le problème c'est quand je supprime la photo elle m'affiche bien la photo blank.jpg mais si je me déplace sur un autre enregistrements et que je reviens sur l'enregistrement de la photo effacer l'image blank.jpg ne s'affiche plus et c'est l'image de l'enregistrement précédent qui s'affiche je n'y comprend rien.

Code sur activation du frm:

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
Private Sub Form_Current()
On Error Resume Next
 
'Affichage de la photo et de son libellé - Gestion d'erreurs
    If IsNull(Me.Photos.Value) Then
 
        Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
 
        Me.LibellePhoto = "Photo non disponible"
 
    Else
 
        Me.Image21.Picture = strRepertoireImages & Me.Photos.Value
 
        Me.LibellePhoto = Left(Me.Photos.Value, InStr(Me.Photos.Value, ".") - 1)
 
    End If
 
    Exit Sub
 
GestionErreur:
 
    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 ", vbCritical + vbOKOnly, "Essai EPI"
 
        Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
 
        Me.LibellePhoto = "Photo non disponible"
 
    Case 2220
 
        'Cas d'un emplacement non valide du fichier image
        MsgBox "Le fichier image n'a pas été trouvé à l'emplacement indiqué : " & vbCrLf & _
                Me.Photos.Value, vbCritical + vbOKOnly, "Essai EPI"
 
        Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
 
        Me.LibellePhoto = "Photo non disponible"
 
    Case Else
        ' tout autre cas d'erreur
        MsgBox "Erreur inattendue : " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Essai EPI"
 
    End Select
 
    'Err.Clear
 
End Sub

Code suppression photo :

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
Function SupprimerPhoto()
On Error Resume Next
 
iRéponse = MsgBox("Attention vous allez supprimer la Photo" & vbNewLine & vbNewLine & _
"Si vous êtes d'accord veuillez confirmer", vbCritical + vbOKCancel, "ATTENTION")
If iRéponse = vbCancel Then
   MsgBox "Suppression Annulée"
Else
 
   'Supprime la photo dans la table
    Me.Photos.Value = vbNullString
   'Affichage de la photo "Non disponible" et modification du libellé
    Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
    'Affiche le libellé
    Me.LibellePhoto = "Photo non disponible"
 
End If
 
End Function

Code insérer photos:

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
Function InsererPhoto()
On Error Resume Next
 
    Dim NomPhoto As String
 
 
    '--------------------------------------------------------------------------------------------
    ' Projet        : Gestion des photos
    ' Appel         :
    ' Auteur        :
    ' Version       : 1.0 - 26.07.2007
    ' Révision      : -
    ' Commentaires  : Permet d'enregistrer le nom de la photo dans la table
    ' Lien          :
    '--------------------------------------------------------------------------------------------
 
    'Ouverture de la boîte de dialogue Ouvrir fichier. On ne récupère que le nom du fichier.
    'Paramètre : 1 pour récupérer le nom du chemin complet
    'Paramètre : 2 pour récupérer uniquement le nom de fichier
    NomPhoto = OuvrirFichier(Me.Hwnd, "Choisir une photo pour cet EPI", 2, "Fichiers photos", "bmp;*.jpg", strRepertoireImages)
 
    'Récupération et stockage du chemin du fichier dans le champ PlongeePhoto
    If NomPhoto <> "" Then
 
    Me.Photos.Value = NomPhoto
 Else
 
 End If
 
    'Affichage de la photo
    Me.Image21.Picture = strRepertoireImages & Me.Photos.Value
 
    'Modification du libellé de la photo
    Me.LibellePhoto = Left(Me.Photos.Value, InStr(Me.Photos.Value, ".") - 1)
 
End Function

Code module liéer les tables:

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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
Option Compare Database
Option Explicit
 
Public strRepertoireDorsale As String
Public strRepertoireImages As String
Dim nbTbl As Long
Dim idx As Long
Dim dbs As DAO.Database
Dim TblDef As DAO.TableDef
 
Function fCheckLinks()
 
'--------------------------------------------------------------------------------------------
' Projet        : Environnement application
' Appel         : Macro ==> AutoExec
' Auteur        : Pierre (3stone) - http://www.3stone.be/access/
' Version       : 1.0
' Révision      : -
' Commentaires  : Permet de vérifier la connexion aux tables attachées
' Lien          : http://www.3stone.be/access/articles.php?lng=fr&pg=28
'--------------------------------------------------------------------------------------------
 
    Dim rst As DAO.Recordset
 
    Set dbs = CurrentDb()
 
    On Error Resume Next
 
    nbTbl = dbs.TableDefs.Count
 
    For idx = 0 To nbTbl - 1
 
        Set TblDef = dbs.TableDefs(idx)
 
        If TblDef.Attributes = dbAttachedTable Then
 
            Set rst = dbs.OpenRecordset(TblDef.Name)
 
        End If
 
    Next idx
 
    If Err <> 0 Then
 
        fRefreshLinks
 
    End If
 
    rst.Close
    dbs.Close
    Set rst = Nothing
    Set dbs = Nothing
 
End Function
 
Sub fRefreshLinks()
 
'--------------------------------------------------------------------------------------------
' Projet        : Environnement application
' Appel         : Function ==> fCheckLinks
' Auteur        : Pierre (3stone) - http://www.3stone.be/access/
' Version       : 1.0
' Révision      : -
' Commentaires  : Permet de rétablir la connexion aux tables attachées
' Lien          : http://www.3stone.be/access/articles.php?lng=fr&pg=28
'--------------------------------------------------------------------------------------------
 
    Dim newpath As String
 
    On Error Resume Next
 
    'Ouverture de la boîte de dialogue Ouvrir fichier ==> Module modDialogbox
    newpath = OuvrirFichier(Application.hWndAccessApp, "Choisir l'emplacement des données !", 1, "Fichier Access", "mdb", "C:")
 
    For idx = 0 To nbTbl - 1
 
        Set TblDef = dbs.TableDefs(idx)
        If TblDef.Connect <> "" Then
 
            TblDef.Connect = ";DATABASE=" & newpath
            TblDef.RefreshLink
 
        End If
 
    Next idx
 
    If Err = 0 Then
 
        MsgBox "Les liaisons ont été rétablies!", vbInformation + vbOKOnly, "Connection réussie"
 
        Exit Sub
 
    Else
 
        If MsgBox("Les données n'ont pas été trouvées " _
            & "dans la base sélectionnée ! Voulez-vous essayer à nouveau ?", _
            vbExclamation + vbYesNo, "Connection non-réussie") = vbNo Then
 
            dbs.Close
            Set dbs = Nothing
            Set TblDef = Nothing
 
            MsgBox "Fermeture de l'application !", vbCritical + vbOKOnly, "Fermeture"
 
            Application.Quit
 
        Else
 
            dbs.Close
            Set dbs = Nothing
            Set TblDef = Nothing
 
            Call fCheckLinks
 
        End If
 
    End If
 
End Sub
 
Function InfosDorsale()
 
'--------------------------------------------------------------------------------------------
' Projet        : Environnement application
' Appel         : Macro ==> AutoExec
' Auteur        :
' Version       : 1.0
' Révision      : -
' Commentaires  : Permet de connaître le chemin complet de la base de données dorsale et le
'               : répertoire dans lequel elle est installée, ainsi que le répertoire des
'                 photos
' Lien          : -
'--------------------------------------------------------------------------------------------
 
    On Error Resume Next
 
    Dim strCheminDorsale As String
 
    'Recherche le nom du répertoire dans lequel est installée la base de données dorsale, ainsi que le nom du fichier
    strCheminDorsale = CurrentDb.TableDefs("Les protections").Connect
    strCheminDorsale = Right(strCheminDorsale, Len(strCheminDorsale) - InStr(1, strCheminDorsale, "DATABASE=") - 8)
 
    'Recherche le nom du répertoire et des sous-répertoires
    If Right(strCheminDorsale, 1) = "\" Then
 
        strRepertoireDorsale = strCheminDorsale
 
    Else
 
        strRepertoireDorsale = Left(strCheminDorsale, InStrRev(strCheminDorsale, "\"))
 
    End If
 
    'Répertoire d'installation de la dorsale
    strRepertoireDorsale = strRepertoireDorsale
 
    'Répertoire d'installation des photos
    strRepertoireImages = strRepertoireDorsale & "Images\"
 
 
 
End Function

[/CODE]
Merci de votre aide

**Domi2** · 13/03/2008, 12h44

Bonjour,

D'abord, peut-être faire une correction, soit faire une gestion d'erreur qui rentre dans la gestion d'erreur :

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
Private Sub Form_Current()

'On Error Resume Next
On Error Goto GestionErreur ' <== Correction ici
 
'Affichage de la photo et de son libellé - Gestion d'erreurs
    If IsNull(Me.Photos.Value) Then
        
        Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
         
        Me.LibellePhoto = "Photo non disponible"
    
    Else
    
        Me.Image21.Picture = strRepertoireImages & Me.Photos.Value
        
        Me.LibellePhoto = Left(Me.Photos.Value, InStr(Me.Photos.Value, ".") - 1)
        
    End If
    
    Exit Sub
    
GestionErreur:
    
    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 ", vbCritical + vbOKOnly, "Essai EPI"
        
        Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
        
        Me.LibellePhoto = "Photo non disponible"
    
    Case 2220
        
        'Cas d'un emplacement non valide du fichier image
        MsgBox "Le fichier image n'a pas été trouvé à l'emplacement indiqué : " & vbCrLf & _
                Me.Photos.Value, vbCritical + vbOKOnly, "Essai EPI"
        
        Me.Image21.Picture = strRepertoireImages & "Blank.jpg"
        
        Me.LibellePhoto = "Photo non disponible"
        
    Case Else
        ' tout autre cas d'erreur
        MsgBox "Erreur inattendue : " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Essai EPI"
    
    End Select
    
    'Err.Clear
 
End Sub

Si tu refais un test, est-ce que tu rentres dans la gestion d'erreurs, ou est-ce que c'est toujours la même chose ?

Domi2

**ThieBEN** · 13/03/2008, 13h44

Envoyé par Domi2

Bonjour,

'On Error Resume Next
On Error Goto GestionErreur ' <== Correction ici

Si tu refais un test, est-ce que tu rentres dans la gestion d'erreurs, ou est-ce que c'est toujours la même chose ?

Domi2

Il affiche :MsgBox "Le fichier image n'a pas été trouvé à l'emplacement indiqué