[AC-2003] Création état sur sous-formulaire filtré [Résolu]

[lucas-18]

Bonjour,

Je fais suite à mon problème de filtre dans la discussion Filtrer formulaire avec case à cocher dont j'ai mis en annexe une partie de ma base.
Je suis occupé à essayer de récupérer les données filtrer de mon sous-formulaire dans un état mais je bloque sur un point.
Lorsque j'ouvre mon état, il m'ouvre tous les enregistrements et pas ceux que j'ai pointé dans la requête de mon état :

Code :

1
2
3
4
SELECT tbl_openamounts.ID, tbl_openamounts.[Invoice leasing company ID], tbl_openamounts.[Contract status code], tbl_openamounts.[Contract ID], tbl_openamounts.[Invoice due date], tbl_openamounts.[Customer ID], tbl_openamounts.[Customer name], tbl_openamounts.[Invoice number], tbl_openamounts.[Invoice invoicing date], tbl_openamounts.[Invoice gross balance (signed)], tbl_openamounts.[Invoice addressee ID], tbl_openamounts.[Invoice addressee name]
FROM tbl_openamounts
WHERE (((tbl_openamounts.[Customer ID])=[Forms]![frm_openamounts].[CustomerID]))
ORDER BY tbl_openamounts.[Contract status code], tbl_openamounts.[Contract ID], tbl_openamounts.[Invoice due date];

Voici le code que j'ai mis dans un module :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Public Function Report_Synchro(frm_openamountscustomer As Form, rpt_openamounts As Report)
    Dim ExpFiltre As String
    Dim ExpTri As String
    ExpFiltre = frm_openamountscustomer.Filter
    rpt_openamounts.RecordSource = frm_openamountscustomer.RecordSource
    If frm_openamountscustomer.FilterOn Then
        rpt_openamounts.Filter = ExpFiltre
        rpt_openamounts.FilterOn = True
    Else
        rpt_openamounts.FilterOn = False
    End If
End Function

Et voici mon appel de fonction sur ouverture de mon état :

Code :

1
2
3
Private Sub Report_Open(Cancel As Integer)
    Call Report_Synchro(Form_frm_openamountscustomer, Report_rpt_openamounts)
End Sub

Une ptite aide serait le bienvenu svp.

[Jeannot45]

Tu peux t'inspirer de l'impression du filtre dans le tuto sur la recherche multicritères

Bonne continuation

[lucas-18]

Je sèche vraiment, j'ai tous essayé j'y suis occupé depuis avant hier non-stop et je ne trouve pas la solution. Je viens encore d'essayer le code suivant sans succès :

Code :

1
2
3
4
5
6
7
Private Sub Openreport_Click()
If Me.frm_openamountscustomer.Form.Filter <> "" Then
DoCmd.OpenReport "rpt_openamounts", acPreview, , Me.frm_openamountscustomer.Form.Filter
Else
DoCmd.OpenReport "rpt_openamounts", acPreview
End If
End Sub

Si qqun pourrait m'expliquer la marche à suivre, çà serait sympa.

Je viens d'essayer le code suivant en pointant sur le numauto du sous formulaire mais il ne m'indique que le 1er numauto :

Code :

1
2
3
4
5
6
7
8
Private Sub Openreport_Click()
    Dim stDocName As String
    Dim strWHERECondition As String
 
    stDocName = "rpt_openamounts"
    strWHERECondition = "[ID]=" & Forms![frm_openamounts]![frm_openamountscustomer].Form![ID]
    DoCmd.OpenReport stDocName, acPreview, , strWHERECondition
End Sub

Pff j'en ai marre

[Jeannot45]

Ci-joint un exemple d'ouverture d'un état basé sur le filtre du sous formulaire.
A toi de jouer maintenant et d'adapter à ton cas particulier

[lucas-18]

Merci à toi
1/ Mais il y a un bug : lorsque je click sélectionnes TOUS dans la liste il me met :

Erreur d'exécution '3075':
Erreur de syntaxe et il me surligne en jaune ce que j'ai coloré en rouge.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub cboInvoiceName_AfterUpdate()  
    If Me.cboInvoiceName.Column(2) = 0 Then
        ' Si le choix dans la liste est "Tous"
       Me.frm_openamountscustomer.Form.RecordSource = p_constStrSqlSelect _
                                                                                               & "WHERE (((tbl_openamounts.[Contract status code])<>'A024' And (tbl_openamounts.[Contract status code])<>'A099')) AND Filtrage = -1" _
                                                                                               & p_constStrSqlOrder
Me.frm_openamountscustomer.Requery
    Else
        ' Génération du filtre
        Call CreerFiltre
    End If
End Sub

2/ En fin de compte j'aimerais ne pas indiquer le critère dans la clause Where :

Code :

(tbl_openamounts.[Contract status code])<>'A024' And (tbl_openamounts.[Contract status code])<>'A099'

Que cloche-t-il dans le code ?

[lucas-18]

Merci à toi
1/ Mais il y a un bug : lorsque je click sélectionnes TOUS dans la liste il me met :

Erreur d'exécution '3075':
Erreur de syntaxe et il me surligne en jaune ce que j'ai coloré en rouge.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub cboInvoiceName_AfterUpdate()  
    If Me.cboInvoiceName.Column(2) = 0 Then
        ' Si le choix dans la liste est "Tous"
Me.frm_openamountscustomer.Form.RecordSource = p_constStrSqlSelect _
& "WHERE (((tbl_openamounts.[Contract status code])<>'A024' And (tbl_openamounts.[Contract status code])<>'A099')) AND Filtrage = -1" _
& p_constStrSqlOrder
Me.frm_openamountscustomer.Requery
    Else
        ' Génération du filtre
        Call CreerFiltre
    End If
End Sub

2/ En fin de compte j'aimerais ne pas indiquer le critère dans la clause Where :

Code :

(tbl_openamounts.[Contract status code])<>'A024' And (tbl_openamounts.[Contract status code])<>'A099'

L'erreur doit vraisemblabement provenir de : Filtrage = -1

[Jeannot45]

Je te prie de m'excuser, tu as presque mis le doigt dessus. Il manque un espace entre le -1 et le dernier guillemet.

Code VBA :

1
2
 
"WHERE Filtrage = -1 "

J'en ai profité pour compléter l'état avec les options choisies et la modification de la clause WHERE

[lucas-18]

Merci infiniment mais il y a encore un problème
Mon état reprend tous les clients en fait et je voudrais avoir les enregistrements du client en rapport avec le formulaire ouvert suivant le champ CustomerID.
J'ai bien essayé de faire une requête dans l'état en pointant sur le champ du formulaire mais cela ne marche pas.

[Jeannot45]

Je viens de regarder.
En fait, il te faut ajouter le [Customer ID] dans la variable p_strSqlWhere.
Par contre je n'ai pas compris pourquoi le [Customer ID] est alpha

Voir ci_dessous

[lucas-18]

Merci Jeannot45 de ton aide, cela a l'air de fonctionner

[lucas-18]

Rebonjour, j'ai parlé trop vite.

1) Lorsque mon formulaire ne contient aucune données, j'obtiens ce message :

Erreur d'exécution '2455':
La référence d'une expression à la propriété Form/Report n'est pas valide.

Il me surligne la ligne suivante dans Sub CreerFiltre() :

Code :

Me.frm_openamountscustomer.Form.RecordSource = p_constStrSqlSelect & p_strSqlWhere & p_constStrSqlOrder

2) Je suis par ailleurs occupé à essayer d'envoyer le résultat de ma requête filtrée dans un mail.
Pour cela, j'ai utilisé le code suivant :

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
Private Sub Commande129_Click()
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim strContenu As String
Dim oRst As DAO.Recordset
Dim oFld As DAO.Field
'Instancie Outlook
Set oApp = CreateObject("Outlook.Application")
'Ouvre un curseur sur la table produits
Set oRst = CurrentDb.OpenRecordset("***")
'Crée un nouveau message
Set oMail = oApp.CreateItem(olMailItem)
'Définit un message HTML
oMail.BodyFormat = olFormatHTML
'Ecrit bonjour en gras
strContenu = "<b>Bonjour !</b>"
'Saute deux lignes
strContenu = strContenu & SAUTLIGNE & SAUTLIGNE
'Ecrit le reste de l'entete
strContenu = strContenu & "<div>Veuillez trouver ci-joint votre relevé.</p>"
 
'Saute deux lignes
strContenu = strContenu & SAUTLIGNE & SAUTLIGNE
'Crée le table
strContenu = strContenu & "<div align=""center""><table>"
'Crée la ligne d'entête
strContenu = strContenu & "<tr>"
'Pour chaque champ, crée une colonne avec le nom du champ
For Each oFld In oRst.Fields
  strContenu = strContenu & "<td><b>" & oFld.Name & "</b></td>"
Next oFld
'Termine la ligne
strContenu = strContenu & "</tr>"
'Pour chaque enregistrement, crée une nouvelle ligne
While Not oRst.EOF
  strContenu = strContenu & "<tr>"
  'Pour chaque champ, crée une colonne avec la valeur du champ
  For Each oFld In oRst.Fields
    strContenu = strContenu & "<td>" & oFld.Value & "</td>"
  Next oFld
  'Termine la ligne
  strContenu = strContenu & "</tr>"
  'Passe à l'enregistrement suivant
  oRst.MoveNext
Wend
'Ferme le tableau
strContenu = strContenu & "</table></div>"
'Affecte le code HTML au mail
oMail.HTMLBody = strContenu
oMail.To = Me.Mailing
oMail.Subject = "Bonjour"
'Envoi le mail
oMail.send
'ferme le curseur
oRst.CLOSE
Set oRst = Nothing
Set oApp = Nothing
End Sub

J'ai essayé ce code directement de ma table et ça marche nickel mais j'aimerais comme pour mon état, n'avoir que le résultat qui apparaît dans mon sous-formulaire (je dois remplacer les *** par du SQL certainement mais je ne sais pas comment m'y prendre).

[lucas-18]

En fait, mon seul problème c'est l'ouverture d'un mail sans qu'il soit directement envoyé avec le résultat de mon sous-formulaire.

Pour ce qui est de l'erreur 2455, j'ai solutionné le problème.

[Jeannot45]

As-tu essayé avec la syntaxe qui te sert de source pour ton état ?

Comment as-tu corrigé ton erreur 2455 ?

[lucas-18]

Pour ce qui concerne l'erreur, je m'aperçois qu'elle n'a lieu qu'en mode création. Les utilisateurs ne voient donc pas ce message d'erreur.

Pour ce qui est de la source de mon état, parles-tu de celle-ci :

Code :

Me.RecordSource = p_constStrSqlSelect & p_strSqlWhere & p_constStrSqlOrder

Si oui, où dois-je la plaçer ?

Merci

[Jeannot45]

Cela reste une proposition :

Code VBA :

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
Private Sub Commande129_Click()
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim strContenu As String
Dim oRst As DAO.Recordset
Dim oFld As DAO.Field
Dim l_strSql as String
'Instancie Outlook
Set oApp = CreateObject("Outlook.Application")
'Ouvre un curseur sur la table produits

' Les variables étant publiques, elles conservent leur valeur
l_strSql = p_constStrSqlSelect & p_strSqlWhere & p_constStrSqlOrder
Set oRst = CurrentDb.OpenRecordset(l_strSql )
'Crée un nouveau message
Set oMail = oApp.CreateItem(olMailItem)
'Définit un message HTML
oMail.BodyFormat = olFormatHTML
'Ecrit bonjour en gras
strContenu = "<b>Bonjour !</b>"
'Saute deux lignes
strContenu = strContenu & SAUTLIGNE & SAUTLIGNE
'Ecrit le reste de l'entete
strContenu = strContenu & "<div>Veuillez trouver ci-joint votre relevé.</p>"
 
'Saute deux lignes
strContenu = strContenu & SAUTLIGNE & SAUTLIGNE
'Crée le table
strContenu = strContenu & "<div align=""center""><table>"
'Crée la ligne d'entête
strContenu = strContenu & "<tr>"
'Pour chaque champ, crée une colonne avec le nom du champ
For Each oFld In oRst.Fields
  strContenu = strContenu & "<td><b>" & oFld.Name & "</b></td>"
Next oFld
'Termine la ligne
strContenu = strContenu & "</tr>"
'Pour chaque enregistrement, crée une nouvelle ligne
While Not oRst.EOF
  strContenu = strContenu & "<tr>"
  'Pour chaque champ, crée une colonne avec la valeur du champ
  For Each oFld In oRst.Fields
    strContenu = strContenu & "<td>" & oFld.Value & "</td>"
  Next oFld
  'Termine la ligne
  strContenu = strContenu & "</tr>"
  'Passe à l'enregistrement suivant
  oRst.MoveNext
Wend
'Ferme le tableau
strContenu = strContenu & "</table></div>"
'Affecte le code HTML au mail
oMail.HTMLBody = strContenu
oMail.To = Me.Mailing
oMail.Subject = "Bonjour"
'Envoi le mail
oMail.send
'ferme le curseur
oRst.CLOSE
Set oRst = Nothing
Set oApp = Nothing
End Sub

[lucas-18]

Merci Jeannot45 mais je suis confronté à 2 problèmes encore :

1) il faudrait que l'email ne soit pas envoyé directement afin que l'utilisateur puisse faire des modifications dans le texte.
2) il faudrait que 2 champs du sous-formulaire n'apparaissent pas dans le mail à savoir "Contract status code" et "Filtrage"

[Jeannot45]

Pour éviter l'apparition de deux champs du sous formulaire, il te suffit de créer une variable p_constStrSqlSelect (avec un autre nom) qui ne reprend pas les deux champs concernés.

Pour éviter l'envoi du mail : peut-être supprimer les lignes 56 et 57 (Comment et instruction)

[lucas-18]

Pour l'envoi du mail la suppression des lignes 56 et 57 faisaient qu'il ne se passaient rien lorsque je clickais sur le bouton de commande.
Par contre, j'ai un peu adapté le code et je suis parvenu à ouvrir le mail sans avoir tenu compte des champs à ne pas reprendre dans le mail.
Par contre je sèche sur la non reprise de certains champs dans mon mail.
J'ai suivi ce que tu m'a dit en faisant ce qui suit mais je ne vois pas où j'ai pu me tromper. Lorsque je click sur le bouton pour ouvrir le mail, il ne me l'ouvre plus et me met comme erreur :

Erreur d'exécution '3141':
Dans l'instruction SELECT, un mot réservé ou un argument est mal orthographié ou absent, ou la ponctuation est incorrecte.

J'ai tout d'abord dans le module DeclarationGenerale inséré ce qui est en gras :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Compare Database
Option Explicit
 
Public p_strSqlWhere As String, p_strIn As String
 
Public Const p_constStrSqlSelect As String = "SELECT ID, [Invoice leasing company ID], [Invoice addressee name], " _
    & "[Contract status code], [Contract ID], [Invoice due date], [Customer name], " _
    & "[Customer ID], [Invoice number], [Invoice invoicing date], [Invoice gross balance (signed)], " _
    & "[Invoice addressee ID], Filtrage " _
    & "FROM tbl_openamounts "
 
Public Const p_constStrSqlSelectOutlook As String = "SELECT ID, [Invoice leasing company ID], [Invoice addressee name], " _
    & "[Contract ID], [Invoice due date], " _
    & "[Invoice number], [Invoice invoicing date], [Invoice gross balance (signed)], " _
    & "FROM tbl_openamounts "
 
Public Const p_constStrSqlOrder As String = " ORDER BY [Invoice addressee name], [Contract status code], [Contract ID], [Invoice due date]"
 
Public Const p_constStrSqlOrderOutlook As String = " ORDER BY [Invoice addressee name], [Contract ID], [Invoice due date]"

Et voici le code de mon bouton de commande :

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
Private Sub Commande129_Click()
If Not IsNull(Me.Email) Then
Dim O As Outlook.Application
Dim Mess As Outlook.MailItem
Dim strContenu As String
Dim oRst As DAO.Recordset
Dim oFld As DAO.Field
Dim l_strSql As String
Set O = New Outlook.Application
l_strSql = p_constStrSqlSelectOutlook & p_strSqlWhere & p_constStrSqlOrderOutlook
Set oRst = CurrentDb.OpenRecordset(l_strSql)
Set Mess = O.CreateItem(olMailItem)
Mess.BodyFormat = olFormatHTML
strContenu = strContenu & "<div>Texte,</p>"
strContenu = strContenu & SAUTLIGNE & SAUTLIGNE
strContenu = strContenu & SAUTLIGNE & SAUTLIGNE
strContenu = strContenu & "<div>-</p>"
strContenu = strContenu & "<div align=""center""><table>"
strContenu = strContenu & "<tr>"
For Each oFld In oRst.Fields
  strContenu = strContenu & "<td><b>" & oFld.Name & "</b></td>"
Next oFld
strContenu = strContenu & "</tr>"
While Not oRst.EOF
  strContenu = strContenu & "<tr>"
  For Each oFld In oRst.Fields
    strContenu = strContenu & "<td>" & oFld.Value & "</td>"
  Next oFld
  strContenu = strContenu & "</tr>"
  oRst.MoveNext
Wend
strContenu = strContenu & "</table></div>"
Mess.To = Me.Email
Mess.HTMLBody = strContenu
Mess.Subject = "Sujet"
Mess.Display
Set Mess = Nothing
Set O = Nothing
Set rst = Nothing
Else
MsgBox "Please select before the email address.", vbInformation, "CTX"
End If
End Sub

[Jeannot45]

L'erreur se trouve à la fin de la ligne 14, il y a une virgule en trop après le champ : [Invoice gross balance (signed)]

Code SQL :

& "[Invoice number], [Invoice invoicing date], [Invoice gross balance (signed)], " _

Bonne journée

[lucas-18]

Un tout GRAND Merci à toi Jeannot45 de m'avoir tant aidé pour toute cette création autour des filtres.