2 pièce(s) jointe(s)
Problème de code en créant un bouton insérer photo dans un formulaire access
Bonjour chers forumistes
Je suis en train de créer une base de données de gestions de personnel avec access 2007. Chaque membre devrait être identifié dans le formulaire avec sa photo. J'ai créer le cadre d'affichage de la photo. Ensuite le bouton insérer photo (image 1).
Pièce jointe 167010
Mais lorsque je clique sur le bouton, j'ai une boîte de dialogue qui m'affiche une erreur de compilation (image 2).
Pièce jointe 167011
Je voudrais vous demander de l'aide pour corriger le code. Voici le code
Code:
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
| Private Sub cmd_closeFormDataGeneral_Click()
On Error GoTo Err_cmd_closeFormDataGeneral_Click
DoCmd.Close
Exit_cmd_closeFormDataGeneral_Click:
Exit Sub
Err_cmd_closeFormDataGeneral_Click:
MsgBox Err.Description
Resume Exit_cmd_closeFormDataGeneral_Click
End Sub
Private Sub cmdPhoto_Click_Click()
'Déclaration des variables
Dim strFichier As String
Dim oFD As FileDialog
'Paramètre la fenêtre Ouvrir
Set oFD = Application.FileDialog(msoFileDialogOpen)
With oFD
'Ajoute les filtres pour fichiers images et tous
With .Filters
.Clear
.Add "Fichiers images", "*.jpg;*.jpeg;*.bmp;*.gif", 1
.Add "Tous", "*.*", 2
End With
'Renseignement du titre
.Title = "Ajouter une image"
'Ouvre l'explorateur dans le fichier 'Mes documents' du User connecté.
.InitialFileName = Environ("USERPROFILE") & "\Mes documents\Mes images"
'Interdit la multi sélection
.AllowMultiSelect = False
'Permet de choisir le mode d'affichage dans l'explorateur (ici apperçu)
.InitialView = msoFileDialogViewPreview
'Permet de personnaliser le bouton.
.ButtonName = "cmdPhoto_Click"
'Affiche la fenêtre
If .Show Then
On Error GoTo fini 'gestion erreur pour control importation
'Retourne un erreur si pas fichier image.
Me.Image1.Picture = .SelectedItems(1)
'Vide du cadre image.
Me.Image1.Picture = ""
'Extraction du nom du fichier à copier.
strFichier = Mid(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
'Copie du fichier sélectionné vers le sous dossier de la base.
FileCopy .SelectedItems(1), CurrentProject.Path & "\images" & strFichier
'Chargement dans control du chemin de l'image (sous dossier base).
Me.Photos = CurrentProject.Path & "\images" & strFichier
'Rafraîchit le Formulaire.
Me.Refresh
End If
End With
Exit Sub
fini:
Select Case Err
Case 2220
MsgBox "L'importation du fichier ne c'est pas effectué normalement.", _
vbCritical, "Erreur fichier Image"
Case Else
MsgBox Err.Number & Chr(13) & Err.Description
End Select
End Sub
Private Sub IndépendantOLE111_Updated(Code As Integer)
' 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 membre 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 membre : " & Me.Nom & " - " & Me.Prénom
Else
Me.Caption = "Saisie d'un nouveau membre"
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
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 pas 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
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"
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 contrôle Picture
If Me.imgPhoto.ImageHeight > Me.imgPhoto.Height Then
' met le contrôle 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 |
Merci pour votre aide