Discussion :

[Mario Rousson]

J'ai réussi à faire ce que je veux en suprimant simplement les deux boutons ajout et delete du code, j'ai remplacé par une commande de lecture automatique de l'image en fonction du nom, je vous fait part des modifications.

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
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 salarié 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 salarié : " & Me.Nom & " - " & Me.Prénom
Else
    Me.Caption = "Saisie d'un nouveau salarié"
End If
 
' Gestion des erreurs
On Error GoTo Catch02
 
' si la photo n'est pas définie, on affiche la photo blank.jpg
' CurrentProject.Path : est le chemin de l'application
If Len(Me.Photo) > 0 Then
    Me.ImgPhoto.Picture = Me.Photo
Else
    Me.ImgPhoto.Picture = CurrentProject.Path & "\images\blank.jpg"
End If
MsgBox CurrentProject.Path
 
Me.ImgPhoto.Picture = CurrentProject.Path & "\images\" & Me.Nom & ".jpg"
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\blank.jpg"
        Me.Photo = vbNullString
    Case 2220
        'Cas d'un emplacement non valide du fichier image
        Rem 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\blank.jpg"
        DisplayPhoto
    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

Et à chaque nouvelle entrer, l'image voulu s'incerere automatiquement, il me reste juste à actualisé à la sortie du champs NOM et BINGO enfin j'imagine.

Je vous avoue que je ne comprend pas l'instruction CurrentProject.Path
je m'explique, dans mon champs Imgphoto j'ai entré le chemin d'acces de la photo blank.jpg qui est:
C:\Users\Mario\Documents\Images\Blank.jpg
quand je demande un msgbox du CurrentProject.Path je reçoit:
C:\Users\Mario\Documents

Pourquoi la partis "\images" n'est pas présent ?

merci

PS. Je suis juste un peu déçus de ne pas avoir réussi à faire fonctionner le code, mais le résultat est la

[bernardmichel]

Simplement parce-que ta demande ne correspond pas tout-à-fait à ton attente :

Code :

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

1
2
3
CurrentProject.Path & "\images\"     ' Te donnera :  "C:\Users\Mario\Documents\Images\"
' et 
CurrentProject.Path     ' Te donnera "C:\Users\Mario\Documents "

Voilu !

Si la solution te convient, penses au tag

Bye et à + ?

[ccam86]

Bonjour à tous,
Je suis nouveau sur le forum. J'espère que répondre à la suite de ce message est autorisé, étant donné qu'il s'agit du même problème, mais sur une version plus récente.

Je rencontre le même souci. Cette fois, je suis sur Access 2021, suite à une mise à jour depuis la version 2007.
Ce problème est rencontré sur tous les formulaires de toutes les bases que j'utilise.

Voici la partie du code qui m'intéresse : lorsque je clique sur le bouton, celui-ci ne réagit pas :

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
Private Sub Commande33_Click()
Dim strLink As String
 
' Gestion des erreurs
On Error GoTo Catch01
'MsgBox CurrentProject.Path
' récupération du chemin physique de la photo
'  par la boite de dialogue
strLink = OuvrirUnFichier(Me.Hwnd, _
                         "Sélectionner une image pour l'aperçu ", _
                         1)
 
' si la boite renvoie une adresse non nulle
If Len(strLink) > 0 Then
    ' tentative d'affichage de la photo
    Me.imgOUV.Picture = GetRelativePath(strLink, CurrentProject.Path)
    Me.OA_PHOTO = GetRelativePath(strLink, CurrentProject.Path)
End If
'MsgBox GetRelativePath(strLink, CurrentProject.Path)
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.OA_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

Je vous insère également l'entièreté du code utilisé sur mon formulaire :

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
Option Compare Database
 
Private Sub Form_Current()
 
'photos
If Len(Me.OA_PHOTO) > 0 Then
    Me.imgOUV.Picture = CurrentProject.Path & "\" & Me.OA_PHOTO
Else
    Me.imgOUV.Picture = CurrentProject.Path & "\divers\blank.jpg"
End If
 
DisplayPhoto
 
'Affichage renseignements vannage/clapet/portes à flots/clapet anti-retour/batardeau/barrage/système anti-refoulement
If Me.OA_TYPE.Value = "bonde" Or Me.OA_TYPE.Value = "vanne" Then
    Me.onglet_vanne.Visible = True
    Me.onglet_buse.Visible = False
    Me.onglet_deversoir.Visible = False
    Me.onglet_plandeau.Visible = False
    Me.onglet_pont.Visible = False
End If
 
'Affichage renseignements buse/passage busé
If Me.OA_TYPE.Value = "passage busé" Or Me.OA_TYPE.Value = "buse" Then
        Me.onglet_vanne.Visible = False
        Me.onglet_buse.Visible = True
        Me.onglet_deversoir.Visible = False
        Me.onglet_plandeau.Visible = False
        Me.onglet_pont.Visible = False
End If
 
'Affichage renseignements déversoir/seuil naturel/seuil artificiel/seuil non maçonné/muret de parcelle/gué
If Me.OA_TYPE.Value = "chute naturelle" Or Me.OA_TYPE.Value = "déversoir" Or Me.OA_TYPE.Value = "brèche" Or Me.OA_TYPE.Value = "batardeau / seuil amovible" Then
        Me.onglet_vanne.Visible = False
        Me.onglet_buse.Visible = False
        Me.onglet_deversoir.Visible = True
        Me.onglet_plandeau.Visible = False
        Me.onglet_pont.Visible = False
End If
 
'Affichage renseignement plan d'eau
If Me.OA_TYPE.Value = "mare sur cours" Or Me.OA_TYPE.Value = "plan d'eau" Then
        Me.onglet_vanne.Visible = False
        Me.onglet_buse.Visible = False
        Me.onglet_deversoir.Visible = False
        Me.onglet_plandeau.Visible = True
        Me.onglet_pont.Visible = False
End If
 
'Affichage renseignements radier de pont
If Me.OA_TYPE.Value = "pont routier / dalot" Then
        Me.onglet_vanne.Visible = False
        Me.onglet_buse.Visible = False
        Me.onglet_deversoir.Visible = False
        Me.onglet_plandeau.Visible = False
        Me.onglet_pont.Visible = True
End If
 
 
End Sub
 
Sub DisplayPhoto()
 
If Me.imgOUV.ImageHeight > Me.imgOUV.Height Then
    Me.imgOUV.SizeMode = 3
Else
    Me.imgOUV.SizeMode = 0
End If
If (Me.imgOUV.ImageWidth > Me.imgOUV.Width) And (Me.imgOUV.SizeMode) = 0 Then
    Me.imgOUV.SizeMode = 3
End If
End Sub
 
Private Sub Commande33_Click()
Dim strLink As String
 
' Gestion des erreurs
On Error GoTo Catch01
'MsgBox CurrentProject.Path
' récupération du chemin physique de la photo
'  par la boite de dialogue
strLink = OuvrirUnFichier(Me.Hwnd, _
                         "Sélectionner une image pour l'aperçu ", _
                         1)
 
' si la boite renvoie une adresse non nulle
If Len(strLink) > 0 Then
    ' tentative d'affichage de la photo
    Me.imgOUV.Picture = GetRelativePath(strLink, CurrentProject.Path)
    Me.OA_PHOTO = GetRelativePath(strLink, CurrentProject.Path)
End If
'MsgBox GetRelativePath(strLink, CurrentProject.Path)
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.OA_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 btn_ajout_ouv_Click()
On Error GoTo Err_btn_ajout_ouv_Click
 
 
    DoCmd.GoToRecord , , acNewRec
 
Exit_btn_ajout_ouv_Click:
    Exit Sub
 
Err_btn_ajout_ouv_Click:
    MsgBox Err.Description
    Resume Exit_btn_ajout_ouv_Click
 
End Sub
Private Sub btn_precedent_Click()
On Error GoTo Err_btn_precedent_Click
 
 
    DoCmd.GoToRecord , , acPrevious
 
Exit_btn_precedent_Click:
    Exit Sub
 
Err_btn_precedent_Click:
    MsgBox Err.Description
    Resume Exit_btn_precedent_Click
 
End Sub
Private Sub btn_suivant_Click()
On Error GoTo Err_btn_suivant_Click
 
 
    DoCmd.GoToRecord , , acNext
 
Exit_btn_suivant_Click:
    Exit Sub
 
Err_btn_suivant_Click:
    MsgBox Err.Description
    Resume Exit_btn_suivant_Click
 
End Sub
 
Private Sub OA_TYPE_AfterUpdate()
 
Me.Requery
 
End Sub

Après maintes recherches, je pense avoir ciblé la source du problème : la version 2007 était en 32 bits, tandis que la version 2021 est en 64 bits j'ai donc rajouté PtrSafe afin que la base puisse s'ouvrir correctement. Voici le code ci-joint, mais maintenant, comment procéder ? Car du coup, il est possible que je ne sois plus dans le bon dossier du forum ?

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
Option Compare Database
Option Explicit
 
'Déclaration de l'API
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
                   "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
 'Structure du fichier
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
 'Constantes
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
 
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
 
 
Public Function OuvrirUnFichier(Handle As Long, _
                                Titre As String, _
                                TypeRetour As Byte, _
                                Optional TitreFiltre As String, _
                                Optional TypeFichier As String) As String
 'OuvrirUnFichier est la fonction a utiliser dans votre formulaire pour ouvrir _
la boîte de dialogue de sélection d'un fichier.
 'Explication des paramètres
    'Handle = le handle de la fenêtre (Me.Hwnd)
    'Titre = Titre de la boîte de dialogue
    'TypeRetour (Définit la valeur, de type String, renvoyée par la fonction)
        '1 = Chemin complet + Nom du fichier
        '2 = Nom fichier seulement
    'TitreFiltre = Titre du filtre
        'Exemple: Fichier Access
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    'TypeFichier = Extention du fichier (Sans le .)
        'Exemple: MDB
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
 
Dim StructFile As OPENFILENAME
Dim sFiltre As String
 
 'Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
 
 'Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) 'Initialisation de la grosseur de la structure
    .hwndOwner = Handle 'Identification du handle de la fenêtre
    .lpstrFilter = sFiltre 'Application du filtre
    .lpstrFile = String$(150, vbNullChar) 'Initialisation du fichier '0' x 254
    .nMaxFile = 150 'Taille maximale du fichier
    .lpstrFileTitle = String$(150, vbNullChar) 'Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 150  'Taille maximale du nom du fichier
    .lpstrTitle = Titre 'Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  'Option de la boite de dialogue
  End With
 
  If (GetOpenFileName(StructFile)) Then 'Si un fichier est sélectionné
    Select Case TypeRetour
      Case 1: OuvrirUnFichier = Trim$(StructFile.lpstrFile)
      Case 2: OuvrirUnFichier = Trim$(StructFile.lpstrFileTitle)
    End Select
  End If
 
End Function

Merci à tous pour vos réponses, qui me seront très utiles.

Cordialement,
ccam86