Forum du club des d�veloppeurs et IT Pro - VBA Access

[AC-365] Erreur d'�xecution 91 : Variable objet ou variablede bloc With non d�finie

arverne63 — Thu, 03 Sep 2026 17:42:11 GMT

Bonsoir,

Je r�alise un publipostage de ACCESS vers WORD pour une association de balisage de chemins de randonn�e avec un code VBA.
Je s�lectionne avec son n� de code un seul adh�rent pour l'informer du montant de son indemnisation. Quand j'ex�cute ce code j'ai ce message d'erreur : Erreur d'�xecution 91 : Variable objet ou variable de bloc With non d�finie � la ligne 88.

Merci d'avance pour votre aide.

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

Sub PayeGM1_Indiv()
     Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim chemin As String
    Dim sqlA As String, sqlS As String, sqlB As String, sqlC As String
    Dim rsA As DAO.Recordset, rsS As DAO.Recordset, rsB As DAO.Recordset, rsC As DAO.Recordset
    Dim db As DAO.Database
    
    Dim dbNumeroRupt As Double      ' pour m�moriser le N� adh�rent en cours
    Dim cptLigneAdr As Long
    Set db = CurrentDb
'sqlA = "SELECT * FROM R_Publipostage_adherents ORDER BY nom_adhe;"

    sqlA = "SELECT * FROM R_Publipostage_adherents" & _
    " LEFT JOIN R_Publipostage_Indemnisations ON R_Publipostage_adherents.numero = R_Publipostage_Indemnisations.num_adhe" & _
    " WHERE Nz([R_Publipostage_Indemnisations.num_adhe],0)='618.2';" 'Pour �diter les courriers des adh�rents ayant droit � une indemnit�

    Set rsA = db.OpenRecordset(sqlA)
    Set wApp = New Word.Application
  ' wApp.Visible = True
    chemin = CurrentProject.Path
     While Not rsA.EOF
     
     cptLigneAdr = 0
    Set wDoc = wApp.Documents.Open(chemin & "\Mod�le-Bourse-Circuits.docx") 'Mettre l'ann�e � jour
 
        cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("civilite") & " " & UCase(rsA.Fields("nom_adhe")) & " " & rsA.Fields("prenom")
        cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("adresse")
If rsA.Fields("addresse2") <> " " Then
    cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("addresse2")
End If
        cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("CodePostal") & " " & UCase(rsA.Fields("Ville"))
        
        sqlB = "SELECT * FROM R_Publipostage_NombrePR WHERE numero=" & rsA.Fields("R_Publipostage_Adherents.numero")
       Set rsB = db.OpenRecordset(sqlB)
        If Not rsB.EOF Then wDoc.Bookmarks("Total").Range.Text = rsB.Fields("Nbr_PR")
        If Not rsB.EOF Then wDoc.Bookmarks("Total1").Range.Text = rsB.Fields("Nbr_Pr")
        If Not rsB.EOF Then wDoc.Bookmarks("NumAdherent").Range.Text = rsB.Fields("numero")
        '--- tableau
        sqlS = "SELECT * FROM R_Publipostage_Circuits WHERE numero=" & rsA.Fields("R_Publipostage_Adherents.numero")
        Set rsS = db.OpenRecordset(sqlS)
        While Not rsS.EOF
            wDoc.Tables(1).Rows.Add
            wDoc.Tables(1).Rows.Last.Cells(1).Range.Text = rsS.Fields("secteur_balirando")
            wDoc.Tables(1).Rows.Last.Cells(2).Range.Text = UCase(rsS.Fields("code"))
            wDoc.Tables(1).Rows.Last.Cells(3).Range.Text = rsS.Fields("nom_pr")
            wDoc.Tables(1).Rows.Last.Cells(4).Range.Text = UCase(rsS.Fields("depart"))
            wDoc.Tables(1).Rows.Last.Cells(5).Range.Text = rsS.Fields("AR_circuit") & " Km"
            wDoc.Tables(1).Rows.Last.Cells(6).Range.Text = rsS.Fields("balisage")
            wDoc.Tables(1).Rows.Last.Cells(7).Range.Text = rsS.Fields("annee_attribution")
            wDoc.Tables(1).Rows.Last.Cells(7).Range.Font.Color = RGB(255, 0, 0)
    'Pour faire apparaitre en rouge les circuits remis � dispositions.
    If rsS.Fields("annee_attribution") = 2021 Then '(Pour bourse aux circuits 2025
    
    wDoc.Tables(1).Rows.Last.Cells(7).Range.Font.Color = RGB(255, 0, 0)
    wDoc.Tables(1).Rows.Last.Cells(7).Range.Font.Bold = True
    Else
    wDoc.Tables(1).Rows.Last.Cells(7).Range.Font.Color = RGB(0, 0, 0)
    wDoc.Tables(1).Rows.Last.Cells(7).Range.Font.Bold = False
End If
            If dbNumeroRupt <> rsA.Fields("numero") Then
                dbNumeroRupt = rsA.Fields("numero")
        sqlC = "SELECT * FROM R_Publipostage_Indemnisations WHERE num_adhe=" & rsA.Fields("numero")
        
        Set rsC = db.OpenRecordset(sqlC)
            wDoc.Bookmarks("TotaldistAR").Range.Text = UCase(rsC.Fields("Km_indemnis�s")) & " Km"
            'wDoc.Bookmarks("Retenus").Range.Text = rsC.Fields("Retenus") & " Km"
            wDoc.Bookmarks("Montant").Range.Text = UCase(rsC.Fields("Montant")) & " �"
            wDoc.Bookmarks("Cheque").Range.Text = rsC.Fields("A percevoir") & ".00 �"
            'wDoc.Bookmarks("Info").Range.Text = IIf(Nz(rsC.Fields("Remarque"), "") = "0", "", Nz(rsC.Fields("Remarque"), "")) 'Permet d'afficher une information � l'adh�rent
            End If
            rsS.MoveNext
 
        Wend
        dbNumeroRupt = 0
 
        'sauvegarde du fichier
        wDoc.SaveAs CurrentProject.Path & "\Publipostage\Indemnisations2026 Bourse circuits2027\Avec indemnisation\Adh�rent unique\Circuits" & " " & rsA.Fields("nom_adhe") & " " & rsA.Fields("prenom") & ".docx"
        wDoc.Close (wdDoNotSaveChanges)
        rsA.MoveNext
    Wend
 
    rsS.Close:  Set rsS = Nothing
    rsA.Close:  Set rsA = Nothing
    db.Close:   Set db = Nothing
    wApp.Quit
    Set wApp = Nothing
    Dim wDoc1 As Object
 
Dim stFicDocs As String
Dim stRepDocs As String
Set wApp = CreateObject("Word.Application")
stRepDocs = (CurrentProject.Path)
 
' Fermer et lib�rer les objets
Set wdapp = Nothing
 
End Sub

[AC-2016] Envoie un fichier depuis access a un etudiant par whatsapp

m_charmat — Sat, 13 Jun 2026 13:45:36 GMT

Bonjour,

Je voulais r�aliser un petit formulaire pour envoyer un fichier a un etudiant depuis un formulaire access vers sont numero de whatsapp.

J'ai trouver une video sur youtube, sur le lien suivant
https://www.youtube.com/watch?si=f-L...ature=youtu.be

seulement je suis bloquer sur le boutton envoi

Code:

1
2
3
Private Sub btnSebMsg_Click()
Call SendWhatsAppMsg(Me.txtToNumber, Nz(Me.txtMsg, ""), Nz(Me.txtFilePath, ""))
End Sub

Qui a un lien avec un module

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
Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
 
Public Function SendWhatsAppMag(toNumber As String, Optional Mag As String, Optional FilePathh As String)
Dim IE As Object
 
    Set IE = CreateObject("InternetExplorer-Application")
    IE.Visible = False
 
    IE.Navigate "whatsapp://send?phone=" & toNumber & "&Text=" & Nz(Mag, "")
    Sleep 2000
 
    If Len(EilePathh) > 5 Then
        SendKeys "+(TAB)"
        SendKeys "~"
        Sleep 2000
        SendKeys " (UP)"
        SendKeys "(UP)"
        SendKeys "~"
        Sleep 2000
        SendKeys Nz(FilePathh, "")
        SendKeys "~"
        Sleep 3000
    Else
        'MagBox "No"
    End If
 
SendKeys "~"
SendKeys "{NUMLOCK}", True
Set IE = Nothing
 
End Function

il m'affiche un probl�me

Code:

Call SendWhatsAppMsg(Me.txtToNumber, Nz(Me.txtMsg, ""), Nz(Me.txtFilePath, ""))

J'arrive pas a trouver le probl�me

Merci

Concatener des filtres

phipirho — Fri, 12 Jun 2026 06:20:01 GMT

Bonjour,
Trois filtres qui fonctionnent individuellement:
' stFilter = "date1 >= " & CDateSQL(daDate1)
' stFilter = "sujet = " & "'" & stName & "'"
' stFilter = "temp > " & dbTemp

Mais qui ne fonctionne pas mis ensemble:
stFilter = " temp > " & dbTemp & " sujet = " & "'" & stName & "'" & " date1 >= " & CDateSQL(daDate1)

Merci d'avance

Appliquer BackColor � un objet TextBox

ggvert — Mon, 08 Jun 2026 14:25:02 GMT

Bonjour,
Petit d�veloppeur pour des applis personnels, je viens de temps � autre sur ce forum pour y trouver r�ponse � un probl�me ponctuel !

Je rencontre une difficult� pour le changement de couleur de fond d'un objet Textbox dans une boucle For each.
Le probl�me s'apparente au sujet abord� en :
https://www.developpez.net/forums/d1...ckcolor-label/
o� je ne trouve pas v�ritablement r�ponse.

Voici le code (partiel) :

Citation:

Dim COL1 As New Collection
Dim c As Control
Dim Compteur As Byte

For Each c In Me
If c.Name Like "NomImageIconographie*" Then COL1.Add c
Next

For Each c In COL1

'c.BackColor = 13553360 ' c'est ok

If Val(Right(c.Name, Len(c.Name) - 20)) > Compteur + 1 Then
'msgbox Right(c.Name, Len(c.Name) - 20) 'donne le num�ro d'index du contr�le - c'est ok
'msgbox c.Name 'c'est ok
c.BackColor = 13553360 'ne fonctionne pas
c.Enabled = False 'c'est ok
End If

Next

On notera que le style de fond des Textbox est "standard".
On notera aussi que, appliqu� � l'ensemble des objets de la collection, BackColor permet bien le changement de couleur de fond de chaque objet.
On notera enfin que la condition If est d'�criture correcte car chaque objet concern� par un changement BackColor est bien �num�r� par "msgbox c.Name"

Quel serait l'avis d'un vrai d�veloppeur ?
Merci pour votre aide.

[AC-365] Probl�me de sauvegarde automatique

cai83 — Sat, 06 Jun 2026 15:05:40 GMT

Bonjour,

J'ai recherch� et trouv� un code VBA permettant de faire une sauvegarde automatique de mes bases de donn�es � la fermeture d'un formulaire.
Cela fonctionne relativement bien. Cependant je rencontre un probl�me avec un base en .accbr. Cela ne foncttionne pas.
Si je reste en accdb �a fonctionne, si je passe sur la m�me base en accdr, la base se bloque (erreur 53) sur l'avant derni�re ligne
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
Private Sub Form_Close()
'sauvegarde automatique de la base
' à la fermeture saisie
 
Dim fich As Object
Dim actuelle, destination As String
 
Set fich = CreateObject("scripting.filesystemobject")
 
'chemin actuel
 
actuelle = "c:\asp\ASP-CCFF  V2.4.1.accdb"
'Chemin et nom de la sauvegarde
'true pour ecraser l'ancienne copie
 
destination = "c:\ASP\ASP_sauvegarde.accdb"
 
 
fich.copyfile actuelle, destination, True
 
Set fich = Nothing
 
 
End Sub

Quelle pourrait en �tre la cause, et y-a-til une methode plus simple
merci

G�n�rer de QR code avec Access

mahrezs — Sat, 18 Apr 2026 11:47:44 GMT

Bonjour, j�essaie de cr�er un formulaire pour g�n�rer des QR CODE avec VBA Access.
� Sur le formulaire j�ai une zone de texte pour �crire texte � convertir, un control image et un bouton.

� J�ai module :

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

� Un code vba pour le bouton( au click) :
�a ne fonctionne pas et je re�ois :

merci pour votre aide.

Images attach�es

[AC-365] Utilisation incorrecte de null

arverne63 — Wed, 08 Apr 2026 13:50:52 GMT

Bonjour,
Dans un publipostage je souhaite afficher l'information "Votre circuit comporte une borne th�matique, merci de joindre sa photo � votre compte rendu de balisage" si la valeur de champ "Bornes" de la requ�te "R_Publipostage_Circuits_Bornes" est Oui et si la valeur est Non ne rien afficher. C'est dans ce cas que l'erreur apparait.

Merci d'avance pour votre aide.

Bonne journ�e.

Erreur d'ex�cutions 94 Utilisation incorrecte de Null dans le code VBA ci-dessous � la ligne 34.

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
Sub Fiche()
    Dim wApp As Word.Application
    Dim chemin As String
    Dim sqlA As String, sqlS As String, sqlB As String, sqlC As String
    Dim rsA As DAO.Recordset, rsS As DAO.Recordset, rsB As DAO.Recordset, rsC As DAO.Recordset
    Dim db As DAO.Database
    Set db = CurrentDb
    sqlA = "SELECT * FROM R_Publipostage_Adherents" & _
    " LEFT JOIN R_Publipostage_Circuits ON R_Publipostage_Adherents.numero = R_Publipostage_Circuits.numero" & _
    " WHERE Nz([R_Publipostage_Circuits.numero],0)=390.3;" 'Renseigner le Num�ro adh�rent pour �diter son courrier
    Set rsA = db.OpenRecordset(sqlA)
    Set wApp = New Word.Application
    wApp.Visible = True
    chemin = CurrentProject.Path
    While Not rsA.EOF
        With wApp
     cptLigneAdr = 0
    Set wDoc = wApp.Documents.Open(chemin & "\Mod�le-circuits-attribu�s-2026.docx") 'mettre l'ann�e � jour
 
        cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("civilite") & " " & UCase(rsA.Fields("nom_adhe")) & " " & rsA.Fields("prenom")
        cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("adresse")
If rsA.Fields("addresse2") <> " " Then
    cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("addresse2")
End If
        cptLigneAdr = cptLigneAdr + 1
        wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("CodePostal") & " " & UCase(rsA.Fields("ville"))
        wDoc.Bookmarks("Prenom1").Range.Text = rsA.Fields("Prenom")

            sqlC = "SELECT * FROM R_Publipostage_Circuits_Bornes WHERE numero_adhe=" & rsA.Fields("R_Publipostage_Adherents.numero")
            Set rsC = db.OpenRecordset(sqlC)
            .ActiveDocument.Bookmarks("InfoBornes").Range.Text = rsC.Fields("Informations")
         'If Not rsC.EOF Then wDoc.Bookmarks("NumAdherent").Range.Text = rsC.Fields("numero_adhe")
 
            sqlB = "SELECT * FROM R_Publipostage_nombrePR WHERE numero=" & rsA.Fields("R_Publipostage_Adherents.numero")
            Set rsB = db.OpenRecordset(sqlB)
            .ActiveDocument.Bookmarks("TotalPR").Range.Text = rsB.Fields("Nbr_PR")
         If Not rsB.EOF Then wDoc.Bookmarks("NumAdherent").Range.Text = rsB.Fields("numero")

            '--- tableau
            sqlS = "SELECT * FROM R_Publipostage_Circuits WHERE numero=" & rsA.Fields("R_Publipostage_Adherents.numero")
            Set rsS = db.OpenRecordset(sqlS)
            With .ActiveDocument.Tables(1)
                While Not rsS.EOF
                    .Rows.Add
                    .Rows.Last.Cells(1).Range.Text = rsS.Fields("secteur_balirando")
                    .Rows.Last.Cells(2).Range.Text = UCase(rsS.Fields("Code"))
                    .Rows.Last.Cells(3).Range.Text = rsS.Fields("nom_pr")
                    .Rows.Last.Cells(4).Range.Text = UCase(rsS.Fields("depart"))
                    .Rows.Last.Cells(5).Range.Text = rsS.Fields("balisage")
                    rsS.MoveNext
                Wend
            End With
 
            '---
            '.ActiveDocument.PrintOut Mettre l'ann�e � jour
            .ActiveDocument.SaveAs "C:\Users\balir\BALIRANDO\2026\Publipostage\Attribution circuits\Adh�rent unique\" & _
            "\Circuits " & Format(Date, "yyyy") & " " & _
                      rsA.Fields("nom_adhe") & " " & rsA.Fields("prenom") & ".docx"
 
 
            .ActiveDocument.Close (wdDoNotSaveChanges)
        End With
        rsA.MoveNext
    Wend
    rsS.Close:  Set rsS = Nothing
    rsA.Close:  Set rsA = Nothing
    db.Close:   Set db = Nothing
    Set wApp = Nothing
End Sub

Ci-dessous le code SQL de la requ�te R_Publipostage_Circuits_Bornes

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
SELECT
    T_Circuits.numero_adhe,
    T_Circuits.code,
    T_Circuits.Secteur_Balirando,
    T_Circuits.nom_pr,
    T_Circuits.Bornes,
    IIf(
        [Bornes] = "Non",
        NULL,
        "Votre circuit comporte une borne thématique, merci de joindre sa photo à votre compte rendu de balisage "
    ) AS Informations
FROM
    T_Circuits;

Formulaire "Recherche multi-crit�res" de Cafeine

DurDur — Mon, 16 Mar 2026 17:46:20 GMT

Bonjour,

Je n'ai pas trouv� comment faire pour totaliser les contenus num�riques d'une colonne ?
(par exemple les totaux des factures obtenus apr�s la recherche)
Est-ce possible ?
Comment faire ?

Merci pour votre aide.

JCB

[AC-2019] lancer depuis 2 formulaires differents un etat unique ayant une requete differente

irimi54 — Sun, 15 Mar 2026 21:46:02 GMT

Bonsoir,

je voudrais lancer un meme �tat "NomEtat" � partir de deux formulaires diff�rents "NomFormulaire1" et "NomFormulaire2" mais l'�tat aura des requ�tes diff�rentes
Pour faire la meme chose avec un formulaire, je fais souvent , par exemple

Code:

1
2
3
4
5
6
7
8
 
Private Sub Liste_Categorie_Change()
If (IsNull(Forms![F_Pesee]![Liste_Sexe])) Then
Me.F_SF_Pesee.Form.RecordSource = "R_Pesee_categorie"
Else
Me.F_SF_Pesee.Form.RecordSource = "R_Pesee_sexe_categorie"
End If
End Sub

mais pour un etat !!! je ne sais pas

[Toutes versions] Pb avec OnKeyDown et une fonction, comment transf�rer KeyCode ?

nemog — Wed, 25 Feb 2026 08:19:20 GMT

Bonjour tout le monde,

J'ai un formulaire avec de nombreuses (variable) textboxes auxquelles je voudrais affecter pendant le chargement du formulaire une fonction sur l'�v�nement OnKeyDown.

Dans un 1er temps (Load du formulaire) :

Code:

1
2
3
4
5
6
7
Dim ctl As Control
 
For Each ctl In Me.Controls
 
ctl.OnKeyDown = "=maFonction(............?)"
 
Next ctl

Dans un 2e temps, dans le vba du formulaire ou un module :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Public Function maFonction(KeyCode ? as ?)
 
   Dim ctl as control
   Set ctl = Screen.ActiveControl
 
    Select Case KeyCode
 
        Case 65        
            'action1
 
        Case 66        
            'action2
 
    End Select
 
End Function

Mon pb est que je n'arrive pas � 'r�cup�rer' la valeur KeyCode produite � l' appui d'une touche( apr�s avoir mis le curseur dans le textbox concern�, bien s�r ).

Qu'est-ce que j'oublie ? ou ne sais pas encore ?

Merci

[AC-2010] Le formulaire se trouve derri�re

dede_bo — Fri, 20 Feb 2026 15:32:29 GMT

Bonjour � tous

Malgr� mes recherches et diff�rent essais ... rien ... cela fonctionne de temps en temps

J'explique
J'ai un formulaire avec un bouton qui permet d'ouvrir un autre formulaire

Code:

1
2
3
 
            DoCmd.OpenForm "Album", acNormal, , "[Achat_ID] = " & RecordID
            Forms("Album").SetFocus

Rien � faire, soit il se met � l'arri�re de tout les formulaires
soit, 1x sur 10 il se met devant
parfois, il semble se fermer tout seul mais, en r�alit� il se place derri�re

J'ai essay� diff�rents code trouv� sur internet mais sans succ�s
J'ai cherch� ici, dans ce forum, mais l�, je ne sais pas quel condition de recherche que je dois utiliser ?

"Bring to front" ... il ne connait pas.

Toutes les id�es sont les bienvenues

Merci d'avance
Andr�

[AC-2019] export d'un requete access vers Excel

irimi54 — Mon, 09 Feb 2026 12:37:55 GMT

Bonjour,

j'ai une requ�te que je veux exporter vers Excel .
Le fichier excel existe et comporte deux feuilles : Donn�es et graphique.
Je voudrais pouvoir exporter le r�sultat de ma requ�te dans la feuille "donn�es" de mani�re � ce que le graphique se mette � jour automatiquement.

Copier la base et envoie par mail

mahrezs — Sat, 31 Jan 2026 15:49:32 GMT

Bonjour,
le travail se pr�sente en deux phases, quand on quitte l�application :
1- faire une copie par mesure de securit� ;
2- Envoyer cette copie par mail.

pour la premi�re parti �a fonction tr�s bien avec le code suivant:

Code:

1
2
3
4
5
6
7
Dim Fiche As Object
Dim Actuelle, Distination As String
Set Fiche = CreateObject("Scripting.filesystemObject")
Actuelle = "C:\Users\mahrez\Desktop\ESSAIE.accdb"
Distination = "D:\SauvegardeESSAIE.accdb"
Fiche.CopyFile Actuelle, Distination, True
Set Fiche = Nothing

pour la deuxi�me parti, je n'arrive pas � envoyer cette copie par mail, avec me code suivant:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim fichier As String
Dim client_msg As New Outlook.Application
Dim message As Outlook.MailItem
Dim adresse As String
fichier = "D:\SauvegardeESSAIE.accdb"
 
Set message = client_msg.CreateItem(olMailItem)
With message
adresse = ("mahrezs@gmail.com")
Subject = "la copie de l'application"
Body = "Application"
Attachments.Add fichier
Send
End With

une solution svp
merci

Images attach�es

Tester pr�sence d'un objet dans une BDD Access

Jean-Luc80 — Tue, 27 Jan 2026 11:08:53 GMT

Bonjour
Dans une BDD j'ai plusieurs formulaires du type DPT_ suivi du nom de d�partement (exemple DPT_Nord)
Mais tous ne sont pas existant
Je voulais savoir si on peut tester en VBA la pr�sence d'un formulaire existant dans la base
en mettant un message d'erreur si celui-ci n'existe pas
Merci pour vos conseils

[AC-2010] La propri�t� 'Picture' reste sur '(none')

dede_bo — Tue, 20 Jan 2026 10:16:10 GMT

Bonjour,

J'ai un probl�me qui me d�passe. Je cherche et je ne trouve pas mon erreur !

J'ai un projet qui affiche un album. Lorsque je double clique sur une photo, un formulaire s'ouvre et affiche la photo en taille r�el.

Le code que j'ai mis derri�re l'�v�nement "onLoad" pour ajouter toute les photos:

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
 
    ' Exemple de données
    ' ListeFichiers => "Fleur_01.jpg|Fleur_02.jpg|Fleur_03.jpg"
 
    ListeFichiers = Forms![Edition_Achat]![ListeDesFichiers]
    d = 1
 
    For ct = 1 To qt
 
        ' Déclaration des 2 objets (1 - photo / 1 - nom du fichier)
 
        Set NomFichier = Me("NomFichier_" + CStr(ct))
        Set Photo = Me("Image_" + CStr(ct))
 
        ' Extrait le nom du fichier et le sauve dans le champs texte
        GoSub cherche
 
        NomFichier.Visible = True
        NomFichier.Value = nom      ' Affiche le nom du fichier
 
        ' Prépare le path complet de l'image et la charge dans l'objet image
        Rep_photo = repertoirePhoto & nom
        Photo.Visible = True
        Photo.Picture = Rep_photo
    Next ct
    Exit Sub
 
cherche:
    ' Extraction du nom de fichier contenu dans la chaine de caratères
    p = InStr(d, ListeFichiers, "|")
 
    If p > 0 Then
        nom = Mid(ListeFichiers, d, p - d)
        d = p + 1
    Else
        nom = Right(ListeFichiers, (Len(ListeFichiers) - d) + 1)
    End If
    Return

Le code derri�re l'�venement "DblClick":

Code:

1
2
3
4
5
6
7
8
9
10
 
Private Sub Image_1_DblClick(Cancel As Integer)
    Dim FichierImage As String
 
    FichierImage = Me.Image_1.Picture
 
    Me.PhotoChoisi = FichierImage
 
    DoCmd.OpenForm "Zoom", acNormal, , , , , "Album"
End Sub

Tout fonctionne � merveille

Maintenant, j'aimerais faire la m�me chose sur un autre projet
J'ai recopi� le code d'un projet � l'autre et en mettant le code � jour afin qu'il fonctionne.

Comme vous voyez sur l'image, la propri�t� "Picture" reste sur "(none)" ...
La configuration des objets et le code VBA sont identiques entre les 2 projets.

J'ai m�me reconstruit le formulaire de "0"
Je ne comprends pas.

Quelqu'un aurait il une id�e?

Merci de votre aide

Andr�

Images attach�es