Discussion :

[KADOMINO]

Bonjour,
Je me suis inspiré du tuto de Cafeine pour la gestion de photos par formulaire dans ma tblArticle. Cette application fonctionnait à merveille jusqu'aujourd'hui.
En effet j'ai installé une nouvelle version d'Office : Professional Plus 2024. Pour ce faire j'ai supprimé toutes les versions d'Office de mon système avant l'installation.
A l'ouverture de mon frmtblArticle, le bouton de cmd "Ajouter / Modifier photo" ne fonctionne plus. Je ne sais plus accéder aux images stockées sur mon PC.
Le bouton de cmd "Supprimer photo" sur d'anciens enregistrements fonctionne.
Si j'ajoute le chemin de la photo dans la tblArticle, la photo est reprise dans le frm.
Que suggèrez-vous ?
D'avance Merci pour vos réponses

[marot_r]

Bonjour

le bouton de cmd "Ajouter / Modifier photo" ne fonctionne plus.

Il ne fonctionne plus comment ?
* Tu as une erreur ? Laquelle ? Sur quelle ligne ?
* Il se passe quelque chose mais pas ce qui était attendu ? Qu'attendais-tu ? Qu'as-tu eu ?
* Il ne se passe rien ? As-tu bien vérifié que le code était appelé ? As-tu exécuté le code pas à pas pour voir ce que faisait réellemment Access ?

A+

[KADOMINO]

Bonjour,
Merci pour ta réponse et joyeuse fêtes de Noël.

Il ne se passe rien hormis la mise en surbrillance du Btn.
Entretemps j'ai installé la version Demo du tuto de Cafeine.
Même problème mais un Msg d'erreur dans le modDialogBox :

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

"Le code contenu dans ce projet doit être mis à jour pour pouvoir être utilisé sur les systèmes 64 bits. Vérifiez et mettez à jour les Instr Declare, puis marquez-les avec l'attribut PtrSafe".

Dans ma version aucun Msg d'erreur !
Ci-dessous copie de mon modDialogBox :

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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
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$(254, vbNullChar) 'Initialisation du fichier '0' x 254
    .nMaxFile = 254 'Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) 'Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  '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
 
et voici [Procédure événementielle] de ma cmdPhoto 
 
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 l'article " & Me.Denomination, _
                         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 la denomination de l'article 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.Denomination) > 0 Then
    Me.Caption = "Détails de l'article : " & Me.Denomination & " - " & Me.Categorie
Else
    Me.Caption = "Saisie d'un nouvel article"
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 kadomino\blank.jpg"
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 Kadomino\blank.jpg"
        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 Kadomino\blank.jpg"
        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

Pour Info le dossier images est à l'adresse suivante D:/Store Documents/Kadomino/Images Kadomino/

Merci pour ton aide.
A+

[hyperion13]

Salut
Avez-vous lu ceci ?
Pensez à utiliser la balise code (#) pour les routines que vous insérez dans vos post.

[User]

Bonjour,

La fonction d'ouverture du fichier semble dater désormais. Si vous souhaitez sélectionner un fichier (ou une image) vous avez aussi l'objet FileDialog :

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
Private Sub cmdPhoto_Click()
    ' Declare une variable comme objet FileDialog
    Dim fd As Office.FileDialog
    Dim strLink As String
 
    ' Gestion des erreurs
    On Error GoTo Catch01
 
    'Créé l'objet FileDialog comme File Picker dialog box. 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 
 
    ' Titre de la boîte de dialogue
    fd.Title = "Sélectionnez un fichier..."
 
    ' Ne pas autoriser la sélection multiple
    ' (donc 1 seul fichier est sélectionnable à la fois)
    fd.AllowMultiSelect = False
 
    ' Effacer les filtres précédents
    fd.Filters.Clear
 
    ' Afficher la boîte de dialogue
    If fd.Show() Then ' on a sélectionné un fichier
        strLink = fd.SelectedItems(1) ' copie dans une variable de l'adresse du fichier choisi 
        Me.imgPhoto.Picture = strLink ' mise à jour du contrôle image
        Me.Photo = strLink ' copie de l'adresse du fichier dans le champ photo
    End If
 
    DisplayPhoto ' procédure de cafeine
    Exit Sub
 
Catch01:
'... gestion de l'erreur
 
End sub

Pour utiliser FileDialog directement dans votre code, vous devez aussi ajouter la bibliothèque Microsoft Office XX.X Object Library :

1. Dans l'éditeur VBA, allez dans le menu Outils > Références.
2. Cochez la case Microsoft Office XX.X Object Library

Cdlt

[KADOMINO]

Salut
Avez-vous lu ceci ?
Pensez à utiliser la balise code (#) pour les routines que vous insérez dans vos post.

Bonjour,
Merci pour l'Info et votre aide.
Je crois que cette procédure est un peu trop complexe pour mes faibles notions en VBA.
A la fin de ce tuto il est mentionné : "Si vous avez le choix, suivez le conseil de Microsoft et installez la version 32 bits.".
Je pense que je vais suivre ce conseil.
Bien à vous.

[hyperion13]

Bonjour,

User que je salue au passage vous a donné une autre solution, bien plus simple.

Un exemple en attache.

[KADOMINO]

Bonjour,

Un grand MERCI à User et Hyperion13.
La db exemple jointe fonctionne sous la version 64 bits.
Il me reste à l'adapter à ma tblArticles.
Je reviens vers vous dès l 'adaptation terminée

[KADOMINO]

Bonjour,

J'ai modifié certains champs et à priori cela fonctionne sauf que de temps en temps j'ai un Msg d'erreur.
Ci-dessous, un aperçu de mon frmqrytblArticle avec l'erreur.


J'exécute le débogage et ai en surbrillance jaune :
Me.imgPhoto.Picture = .SelectedItems(1)

J'arrête le débogeur, reviens vers mon frm et y ajoute à nouveau des Art et photos dans ma table (tblArticle)

Avez-vous une idée pour éviter ce désagrément ?

[User]

Bonjour à vous deux ,

Le même enregistrement semble être modifié/ouvert à deux endroits différents, ou sur deux formulaires différents (conflit d'écriture).

Je vois le formulaire "Euro converter" je ne sais s'il a la même source articles que le formulaire "Articles" (vu le prix unitaire) alors peut-être le fermer avant d'ajouter/modifier une image.

Cdlt

[hyperion13]

Bonjour,

Voire un problème de connexion avec la clé USB dus à des temps de réponses variables.

[KADOMINO]

Bonjour à vous deux,

Merci pour vos réponses.
To :
- USER : le btn "EuroConverter" est tout à fait indépendant de la tblArticle

- HYPERION13 : aucune clé USB n'est utilisée.

Je crois que le problème vient du btn "Dupliquer ce fichier".
Ce btn me permet de copier le dernier enregistrement afin d'éviter de recopier les mêmes données dans les différents champs de la tblArticle.
Voici le code qui est utilisé :

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
 
Private Sub CommandDuplicateRecord_Click()
On Error GoTo Err_CommandDuplicateRecord_Click
 
 
    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append
 
Exit_CommandDuplicateRecord_Click:
    Exit Sub
 
Err_CommandDuplicateRecord_Click:
    MsgBox Err.Description
    Resume Exit_CommandDuplicateRecord_Click
 
End Sub

Quand je n'utilise pas cette Cmd : aucun problème.
Bonnes fêtes de fin d'année

[Informt2025]

La fonction de l'ouverture de fichiers n'est pas implémentée correctement et se limite qu'à la version ainsi donc si le nom de fichier contient des caractères Unicode elle échouera ..

Voila un exemple qui intègre les deux opérations d'ouverture et de sauvegarde des fichiers

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
Option Explicit
 
Private Declare PtrSafe Function GetOpenFileNameW Lib "comdlg32" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function GetSaveFileNameW Lib "comdlg32" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As LongPtr
    lpstrCustomFilter As LongPtr
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As LongPtr
    nMaxFile As Long
    lpstrFileTitle As LongPtr
    nMaxFileTitle As Long
    lpstrInitialDir As LongPtr
    lpstrTitle As LongPtr
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As LongPtr
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As LongPtr
    pvReserved As LongPtr
    dwReserved As Long
    FlagsEx As Long
End Type
Private Const MAX_PATH = 260
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_FILEMUSTEXIST = &H1000
 
Public Function PromptForFileName( _
                  Optional AFilter As String = "Tous les fichiers *.*|*.*", _
                  Optional ADefaultExt As String = "", _
                  Optional ATitle As String = "", _
                  Optional AInitialDir As String = "", _
                  Optional ASave As Boolean = False)
    Dim Dialog As OPENFILENAME
    Dim szFilter As String
    Dim strFile As String
    Dim ret As Long
    strFile = Space$(MAX_PATH)
    szFilter = Replace(AFilter, "|", vbNullChar) & vbNullChar
    With Dialog
        .lStructSize = LenB(Dialog)
        .hWndOwner = 0
        .lpstrFilter = StrPtr(szFilter)
        .lpstrFile = StrPtr(strFile)
        .nMaxFile = MAX_PATH
        .lpstrTitle = StrPtr(ATitle)
        .lpstrInitialDir = StrPtr(AInitialDir)
        .lpstrDefExt = StrPtr(ADefaultExt)
        .flags = OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    End With
    If ASave Then
       ret = GetSaveFileNameW(Dialog)
    Else
       ret = GetOpenFileNameW(Dialog)
    End If
    PromptForFileName = ret <> 0
    If PromptForFileName Then
      PromptForFileName = Trim$(strFile)
    End If
End Function

Pour l'ouverture d'un fichier:

Code :

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

1
2
3
4
5
6
7
8
Dim Filter As String, Sel
   Filter = "Toutes les images *.bmp *.jpg *.gif|*.bmp;*.jpg;*.jpeg;*.gif"
   Filter = Filter & "|Images dib *.bmp|*.bmp"
   Filter = Filter & "|Image jpg|*.jpg;*.jpeg"
   Filter = Filter & "|Image gif|*.gif"
   Sel = PromptForFileName(Filter)
 
   TextBox1 = Sel

Pour l'enregistrement , juste en mettant le parametre ASave à True

Code :

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

   Sel = PromptForFileName(Filter, ASave:=True)

Dans les deux cas la fonction renvoie False si l'utilisateur annule l’opération.

[KADOMINO]

Bonjour,
Mes meilleurs voeux à toute la communauté.
Merci à Informt2025 pour sa réponse mais :
Si je modifie la procédure événementielle initiale "au clic" de mon Bnt CommandDuplicateRecord, rien ne se passe.
Je me pose la question : Où je dois placer son code ?
Quelqu'un peut-il éclairer ma lanterne.
D'avance Merci

[User]

Bonjour,

Votre méthode type « copier-coller » peut provoquer des conflits d'écriture ou mettre un verrou au niveau de l'enregistrement.

Il vaudrait mieux utiliser la librairie DAO pour dupliquer vos enregistrements :

https://warin.developpez.com/access/...=partie_5#L5-4

Cdlt

[User]

Bonjour,

Il y a aussi la possibilité d'exécuter une requête insertion pour dupliquer l'enregistrement :

Code :

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

1
2
3
4
strSQL = "INSERT INTO Table1 (Champ1, Champ2, Champ3) " & _
         "SELECT Champ1, Champ2, Champ3 FROM Table1 WHERE ID = " & Me.ID
 
CurrentDb.Execute strSQL, dbFailOnError

Tout ça à adapter bien sûr