Je bloque sur le code VB de mon application ACCESS
silver
-
11 avril 2001 à 16:41
cs_EBArtSoft
Messages postés4525Date d'inscriptiondimanche 29 septembre 2002StatutModérateurDernière intervention22 avril 2019
-
7 août 2007 à 10:58
J'ai crée une base de données constituée de 2 tables principales : Clients & type
Elles sont reliéeés entre elles!
Dans mes formulaires j'ai un formulaire de recherche qui permet de trouver les clients qui répondent a certains critères (ville nom, CP, son type...)
Une fois les critères choisis il suffit de cliquer sur le bouton "Rechercher" et les résultats cad les références des personnes s'affichent dans une zone de liste.
Apres on peut cliquer sur une ou plusieurs personnes parmi celles trouvées pour les sélectionner. Seules ces personnes sélectionnées apparaitront dans les états éventuelles que je pourrai créer!
Ce que je voudrais c'est pouvoir créer un bouton "Cumuler" qui permet de cumuler les personnes sélectionnées au fur et a mesure que l'on effectue des recherches sur ce formulaire.
Une fois ces personnes cumulées il faut pouvoir "Sauvegarder" ce cumul pour pouvoir le "Charger" par la suite.
Mais ce qui me pose vraiment problème, c'est le cumul qui ne veut pas se faire! En effet, quand on clique sur le bouton rechercher le cumul est automatiquement annulé et je sais pas pourquoi?
Je souhaite cumuler les personnes sélectionnées d'une recherche à une autre pour pouvoir sauver ce cumul à la fin !!
Je vous laisse le Code VB il pourra peut-etre vous aider!
Le bouton cumul porte le nom "Commande85" :
Je vous en supplie aidez-moi c'est pour un rapport de fin d'année et je sens que je suis mal barré!!!
Option Compare Database
Option Explicit
Dim Cond As String
Dim qry As String
Dim QryEch As String
Dim Qryech2 As String
Const Cli = "Clients"
Dim MetNonAffichable As Boolean
Dim MetQueAdhérents As Boolean
'Dim MetDerniers As Boolean
Dim MetQueActiAnnul As Boolean
Dim ActiSel As Boolean
Dim QueActiAvecEch As Boolean
Dim Rtat As String
Private Sub ActiAvecEch_Click()
QueActiAvecEch = Me.ActiAvecEch.Value
Call ChercheActi_Click
End Sub
Private Sub ApercuEtat_Click()
'Procedure executée lors du clic sur
'le bouton Aperçu de l'Etat
'Determine quel est l'etat selectionné dans liste
'puis l'ouvre en mode Aperçu avec les données
'filtrées
On Error GoTo ApercuEtatErr
Dim quelEtat As String
Dim cok As Boolean
Dim i As Integer
cok = False
quelEtat = vbNullString
With Me.CboEtats
i = .ListIndex
If i <> -1 Then
quelEtat = .ItemData(i)
cok = True
End If
End With
If cok = False Then
MsgBox "Vous devez d'abord selectionner un état dans la liste", vbOKOnly + vbCritical, "Erreur"
Else
'Debug.Print quelEtat
Select Case quelEtat
Case "AccuséRéception" '1 refetat
AfficheEtatAccuseRecep (quelEtat)
Case "Adresse35x70" '2
'AfficheEtatEtiquette35x70
AfficheEtatEtiquette (quelEtat)
Case "Adresse37x105" '3
AfficheEtatEtiquette (quelEtat)
Case "Carte35x70G" '4
AfficheEtatEtiquette (quelEtat)
Case "Annulation" '5
AfficheEtat (quelEtat)
Case "InscritsParActivité" '6
AfficheEtat (quelEtat)
Case "MesStats" '7
AffEtatCalc
Case "Etat des comptes Ech" '8
AfficheEtat (quelEtat)
Case "Etat des comptes ss ech" '9
AfficheEtat (quelEtat)
Case "ConfirmInscr" '10
AfficheEtatAccuseRecep (quelEtat)
Case "Etat des comptes personnes en retard avec ech" '11
EnRetard (quelEtat)
Case "Etat des comptes personnes en retard ss ech" '12
EnRetard (quelEtat)
'ConfirmInscr
End Select
End If
Exit Sub
ApercuEtatErr:
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub ChercheActi_Click()
'Procedure executée lors du clic sur le bouton
'cherche Activités
'Affiche dans la list box les activités
'de l'année voulue
On Error GoTo ChercheActierr:
Dim An As Integer
Dim QryPlus As String
Dim Cond As String
An = AnnéeEnCours
'If Me.QueActiAnnul = 0 Then
' QryPlus = Qry & An & "))order by Datedebut;"
' Else
' QryPlus = Qry & An & ")) AND Annulée=-1 order by Datedebut;"
'End If
If Me.QueActiAnnul = 0 Then
Cond = An & "))"
Else
Cond = An & ")) AND Annulée=-1 "
End If
If QueActiAvecEch Then
QryPlus = QryEch & " " & Cond & Qryech2
'Debug.Print QryPlus
' MsgBox "toto"
Else
QryPlus = qry & " " & Cond & "order by Datedebut;"
End If
LboxActivités.RowSource = QryPlus
Exit Sub
ChercheActierr:
MsgBox Err & " " & Err.Description
End Sub
Private Sub Commande0_Click()
On Error GoTo Err_Commande0_Click
Private Sub Commande20_Click()
On Error GoTo Err_Commande20_Click
Dim Req As String
Dim temp As String
Dim rajet As Boolean
rajet = False
temp = vbNullString
Req = vbNullString
If PersoSelectionnees(temp) = True Then
Req = "(" & temp & ")"
rajet = True
End If
If ActiSelectionneesEtat(temp) = True Then If rajet True Then Req Req & " AND "
Req = Req & "(" & temp & ")"
rajet = True
End If
'req = "Clients.Numadhe Is Not Null"
'Procédure qui permet le cumul des différentes sélections effectuées
'cette méthode doit lancer la nouvelle recherche et cumuler les sélections aux précédentes
Private Sub Commande85_Click()
Dim temp As String
Dim rajet As Boolean
Dim Req As String
Dim Req2 As String
rajet = False
temp = vbNullString
Req = Req2
If PersoSelectionnees(temp) = True Then
Req = Req & "(" & temp & ")"
rajet = True
End If
Me.essai.Value = Req
Req2 = Req
End Sub
Private Function PersoSelectionnees(Req As String)
'fonction determinant quelles sont les personnes selectionnées
'retourne vrai si des personnes sont selectionnées
'req by ref; req est passé par reference et contient
'une clause where correspondant aux perso selectionnées
'req by ref
On Error GoTo PersoSelectErr
Dim i As Integer
Dim temp As String
Dim PersoWh As String
Dim Premier As Boolean
Dim cok As Boolean
PersoWh = vbNullString
Premier = True
cok = False
With Me.lbRésultat
For i = 1 To .ListCount - 1
If .Selected(i) Then
temp = .ItemData(i)
If Premier = True Then PersoWh PersoWh & "Clients.refpersonne In (" & temp 'PersoWh PersoWh & "Clients.refpersonne =" & Temp
Premier = False
cok = True
Else PersoWh PersoWh & "," & temp 'PersoWh PersoWh & " OR " & "Clients.refpersonne=" & Temp
End If
End If
Next
If .ListCount > 0 Then PersoWh = PersoWh & ")"
End With
Req = PersoWh
PersoSelectionnees = cok
Exit Function
PersoSelectErr:
MsgBox Err & " " & Err.Description
Exit Function
End Function
Private Sub Détail_Click()
'SELECT Clients.*
'FROM Clients
'where left(CP,2)="34";
End Sub
Private Sub Form_Load()
'Procedure executée au chargement
'de la feuille, init des variables
On Error GoTo formloaderr
Cond = vbNullString
Dim QryPlus As String
Dim An As Integer
Modifiable69.SetFocus
MetNonAffichable = False
MetQueAdhérents = False
'MetDerniers = False
MetQueActiAnnul = False
QryPlus = qry & An & "))order by Datedebut;"
LboxActivités.RowSource = QryPlus
Exit Sub
formloaderr:
MsgBox Err & " " & Err.Description
End Sub
Private Sub derniers_Click()
'MetDerniers = Me.derniers.Value
'Call Rechercher_Click
End Sub
Private Sub InclureNonAff_Click()
'Procédure executée lors du clic
'sur la case à cocher Inclure non affichables
'Lance la recherche en incluant
'les personnes non affichables
MetNonAffichable = Me.InclureNonAff.Value
Call Rechercher_Click
End Sub
Private Sub QueActiAnnul_Click()
'Procedure executée lors du clic
'sur le case à cocher Que les activités annulées
'Lance la recherche des activités an affichant
'que les activités annulées
MetQueActiAnnul = Me.QueActiAnnul.Value
Call ChercheActi_Click
End Sub
Private Sub QueAdhérents_Click()
'Procédure executée lors du clic sur la case à cocher
'Mettre que les adhèrents
'Lance la recherche en affichant que
'les adhèrents
MetQueAdhérents = Me.QueAdhérents.Value
Call Rechercher_Click
End Sub
Private Sub Rechercher_Click()
'Procedure executée lors du clic
'sur le bouton rechercher
'Permet de faire une recherche selon
'les critères selectionnés.
'En fait, on construit le texte
'd'une requête SQL selon les critères
'choisis.
On Error GoTo RecherErr
Dim Conditions As String
Dim temp, Temp2 As String
Dim ResActi As String
Dim Req As String
Dim datDeb, datFin As String
Dim i, Nbtrouv As Integer
Dim ClauseWh As Boolean
Dim rajet As Boolean
If IsNull(Me.Modifiable69) = False Then
temp = Me.Modifiable69
i = Len(temp)
Conditions = Conditions & "left(" & Cli & ".Structure," & i & ")='" & temp & "'"
ClauseWh = True
rajet = True
End If
If IsNull(Me.Modifiable67) = False Then
temp = Me.Modifiable67
i = Len(temp) If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & "left(lcase(" & Cli & ".Type)," & i & ")='" & temp & "'"
ClauseWh = True
rajet = True
End If
If IsNull(Me.CPostal) = False Then
temp = Me.CPostal
i = Len(temp) If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & "left(lcase(" & Cli & ".CP)," & i & ")='" & temp & "'"
ClauseWh = True
rajet = True
End If
If IsNull(Me.Ville) = False Then
temp = Me.Ville
i = Len(temp) If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & "left(lcase(" & Cli & ".Ville)," & i & ")='" & temp & "'"
ClauseWh = True
rajet = True
End If
If IsNull(Me.Lenom) = False Then
temp = Me.Lenom
i = Len(temp) If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & "left(lcase(" & Cli & ".Nomprenom)," & i & ")='" & temp & "'"
ClauseWh = True
rajet = True
End If
'test activité
If ActiSelectionnees(ResActi) = False Then
Req = Req & "FROM Clients "
ActiSel = False
Else
Req = Req & "FROM Clients,Factures "
ActiSel = True If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & "(" & ResActi & ") AND (Clients.refpersonne=Factures.refpersonne) "
ClauseWh = True
rajet = True
End If
If Me.RechParDate.Value = True Then
If ActiSel = False Then
MsgBox "Vous devez selectioner une activité", vbOKOnly + vbCritical
Exit Sub
Else
If IsNull(Me.Rdebut) Or IsNull(Me.Rfin) Then
MsgBox "Vous devez saisir une date de début et une date de fin", vbOKOnly + vbCritical
Else datDeb Me.Rdebut: datFin Me.Rfin If rajet True Then Conditions Conditions & " AND "
'dates a l'americaine mm/jj/aaaa
datDeb = Month(datDeb) & "/" & Day(datDeb) & "/" & Year(datDeb)
datFin = Month(datFin) & "/" & Day(datFin) & "/" & Year(datFin)
'MsgBox datDeb & " " & datFin
Conditions = Conditions & "(((Factures.DateInscr) Between #" & datDeb & "# And #" & datFin & "#)) "
ClauseWh = True
rajet = True
End If
End If
End If
If MetNonAffichable = False Then If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & " (Clients.Affichable=YES)"
rajet = True
ClauseWh = True
End If
If MetQueAdhérents = True Then If rajet True Then Conditions Conditions & " AND "
Conditions = Conditions & " (((Clients.Numadhe) Is Not Null))"
rajet = True
ClauseWh = True
End If
'If ClauseWh True Then Req Req & "Where " & Conditions & ";"If ClauseWh True Then Req Req & "Where " & Conditions '& ";"
'Debug.Print req
Rtat = Req
Me.lbRésultat.RowSource = Req & " order by Clients.Nomprenom ;"
Nbtrouv = Me.lbRésultat.ListCount - 1
If Nbtrouv -1 Then Nbtrouv 0
Temp2 = "Nombre de personnes trouvées : " & Nbtrouv
Me.PersTrouv.Caption = Temp2
'Call SelectTtesPersonnes_Click
'For i = 0 To Me.lbRésultat.ListCount - 1
'Debug.Print Me.lbRésultat.ItemData(i)
'Next
Exit Sub
RecherErr:
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub RechParDate_Click()
'Procedure executée lors du clic sur la case
'a cocher recherche par date
'Rend accessible les zones de date ou non
Me.Rdebut.Enabled = Not Me.Rdebut.Enabled
Me.Rfin.Enabled = Not Me.Rfin.Enabled
End Sub
Private Sub SelectionTTES_Click()
'Procedure exedcutée lors du clic sur le bouton
'Selectionner toutes (activités)
'Selectionne toutes les activités de la liste
On Error GoTo SelTtesErr
Dim i As Integer
Screen.MousePointer = 11 ' hourglass
For i = 0 To Me.LboxActivités.ListCount - 1
Me.LboxActivités.Selected(i) = True
Next
Screen.MousePointer = 0 ' defaut
Exit Sub
SelTtesErr:
Screen.MousePointer = 0 ' defaut
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub DeselectTTES_Click()
'Procedure exedcutée lors du clic sur le bouton
'Desélectionner toutes (activités)
'Deselectionne toutes les activités de la liste
On Error GoTo DSelTtesErr
Dim i As Integer
Screen.MousePointer = 11 ' hourglass
For i = 0 To Me.LboxActivités.ListCount - 1
Me.LboxActivités.Selected(i) = False
Next
Screen.MousePointer = 0 ' defaut
Exit Sub
DSelTtesErr:
Screen.MousePointer = 0 ' defaut
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub InverserSelect_Click()
'Procedure exedcutée lors du clic sur le bouton
'Inverser la Selection (activités)
'Inverse la selection dans la liste
On Error GoTo ISelTtesErr
Dim i As Integer
Screen.MousePointer = 11 ' hourglass
For i = 0 To Me.LboxActivités.ListCount - 1
Me.LboxActivités.Selected(i) = Not (Me.LboxActivités.Selected(i))
Next
Screen.MousePointer = 0 ' defaut
Exit Sub
ISelTtesErr:
Screen.MousePointer = 0 ' defaut
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub SelectTtesPersonnes_Click()
On Error GoTo SelTtesPErr
Dim i As Integer
Dim max As Integer
'ETCompteur.Caption = " 0 / 0 "
Screen.MousePointer = 11 ' hourglass
''max = lbRésultat.ListCount - 1
max = Me.lbRésultat.ListCount - 1
For i = 0 To max
Me.lbRésultat.Selected(i) = True
Next
Screen.MousePointer = 0 ' defaut
Exit Sub
SelTtesPErr:
Screen.MousePointer = 0 ' defaut
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub DeselectTtesPersonnes_Click()
'Procedure exedcutée lors du clic sur le bouton
'Deselectionner toutes (presonnes)
'Deselectionne toutes les personnes de la liste
On Error GoTo DSelTtesPErr
Dim i As Integer
Screen.MousePointer = 11 ' hourglass
For i = 0 To Me.lbRésultat.ListCount - 1
Me.lbRésultat.Selected(i) = False
Next
Screen.MousePointer = 0 ' defaut
Exit Sub
DSelTtesPErr:
Screen.MousePointer = 0 ' defaut
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub InverseSelTtesPersonnes_Click()
On Error GoTo ISelTtesPErr
Dim i As Integer
Screen.MousePointer = 11 ' hourglass
For i = 0 To Me.lbRésultat.ListCount - 1
Me.lbRésultat.Selected(i) = Not (Me.lbRésultat.Selected(i))
Next
Screen.MousePointer = 0 ' defaut
Exit Sub
ISelTtesPErr:
Screen.MousePointer = 0 ' defaut
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Function ActiSelectionnees(Req As String)
'fonction determinant quelles sont les activitées selectionnées
'retourne vrai si des activités sont selectionnées
'req by ref; req est passé par reference et contient
'une clause where correspondant aux acti selectionnées
On Error GoTo ActiSelectErr
Dim i As Integer
Dim temp As String
Dim ActivWh As String
Dim Premier As Boolean
Dim cok As Boolean
ActivWh = vbNullString
Premier = True
cok = False
With Me.LboxActivités
For i = 1 To .ListCount - 1
If .Selected(i) Then 'Factures.refacti In(XXX,XXY ...
temp = .ItemData(i)
If Premier = True Then ActivWh ActivWh & "Factures.refacti In (" & temp 'ActivWh ActivWh & "Factures.refacti=" & Temp
Premier = False
cok = True
Else ActivWh ActivWh & "," & temp 'ActivWh ActivWh & " OR " & "Factures.refacti=" & Temp
End If
End If
Next
If .ListCount > 0 Then ActivWh = ActivWh & ")"
End With
Req = ActivWh
ActiSelectionnees = cok
Exit Function
ActiSelectErr:
MsgBox Err & " " & Err.Description
Exit Function
End Function
Private Function ActiSelectionneesEtat(Req As String)
'fonction determinant quelles sont les activitées selectionnées
'retourne vrai si des activités sont selectionnées
'req by ref; req est passé par reference et contient
'une clause where correspondant aux acti selectionnées
'req by ref
'Cette fonction est similaire à la precedente mais retourne une chaine
'legerement différente
On Error GoTo ActiSelectEtatErr
Dim i As Integer
Dim temp As String
Dim ActivWh As String
Dim Premier As Boolean
Dim cok As Boolean
ActivWh = vbNullString
Premier = True
cok = False
With Me.LboxActivités
For i = 1 To .ListCount - 1
If .Selected(i) Then 'Activites.refacti in(XXX,XXY, ...)
temp = .ItemData(i)
If Premier = True Then ActivWh ActivWh & "Activites.refacti In (" & temp 'ActivWh ActivWh & "Activites.refacti=" & Temp
Premier = False
cok = True
Else ActivWh ActivWh & "," & temp 'ActivWh ActivWh & " OR " & "Activites.refacti=" & Temp
End If
End If
Next
If .ListCount > 0 Then ActivWh = ActivWh & ")"
End With
Req = ActivWh
ActiSelectionneesEtat = cok
Exit Function
ActiSelectEtatErr:
MsgBox Err & " " & Err.Description
Exit Function
End Function
Private Sub qelsEtats()
Dim rpt As Report, ctl As Control
' Enumère la collection Reports.
For Each rpt In Reports
' Imprime le nom de l'état.
'Debug.Print rpt.Name
' Enumère la collection Controls de chaque état.
For Each ctl In rpt.Controls
' Imprime le nom de chaque contrôle.
' Debug.Print ">>>"; ctl.Name
Next ctl
Next rpt
End Sub
Private Sub AfficheEtatAccuseRecep(quel As String)
'Procedure permettant l'affichage de l'etat accusé de
'reception et de la confirmation avec le filtre approrpié
On Error GoTo AfficheEtatARErr
Dim Req As String
Dim temp As String
Dim rajet As Boolean
Dim YaselPers As Boolean
rajet = False
temp = vbNullString
Req = vbNullString
If PersoSelectionnees(temp) = True Then
Req = "(" & temp & ")"
rajet = True
End If
If ActiSelectionneesEtat(temp) = True Then If rajet True Then Req Req & " AND "
Req = Req & "(" & temp & ")"
rajet = True
End If
If MetNonAffichable = False Then If rajet True Then Req Req & " AND "
Req = Req & " (Clients.Affichable=YES)"
End If
If MetQueAdhérents = True Then If rajet True Then Req Req & " AND "
Req = Req & " (((Clients.Numadhe) Is Not Null))"
rajet = True
End If
'Debug.Print req
'MsgBox "toto"
'If rajET Then
DoCmd.OpenReport quel, acPreview, , Req
' Else
' DoCmd.OpenReport "AccuséRéception", acPreview, Rtat
' End If
Exit Sub
AfficheEtatARErr:
MsgBox Err.Description
Exit Sub
End Sub
Private Sub AfficheEtat(quel As String)
'Procedure permettant d'afficher l'etat dont le nom
'et passé en parametre; concerne Annulation
'inscrits par activités et etat des comptes
On Error GoTo AfficheEtatErr
Dim Req As String
Dim temp As String
Dim rajet As Boolean
Dim YaselPers As Boolean
rajet = False
temp = vbNullString
Req = vbNullString
If quel = "InscritsParActivité" Then
Dim Src As String
Src = "SELECT DISTINCTROW [JointureClientsActivitésParFacture].[Titre], "
[JointureClientsActivitésParFacture].[Nomprenom], [JointureClientsActivitésParFacture].[Ville], [JointureClientsActivitésParFacture].[Pays], [JointureClientsActivitésParFacture].[Date de naissance], [JointureClientsActivitésParFacture].[Telperso], [JointureClientsActivitésParFacture].[Teltravail], [JointureClientsActivitésParFacture].[Numadhe], [JointureClientsActivitésParFacture].[Nom Activité], [JointureClientsActivitésParFacture].[Datedebut], [JointureClientsActivitésParFacture].[Datefin], [JointureClientsActivitésParFacture].[Prix], [Activites].[refacti] FROM ([JointureClientsActivitésParFacture] INNER JOIN [Activites] ON [JointureClientsActivitésParFacture].[Activites].[refacti] =[Activites].[refacti])"
If ActiSelectionneesEtat(temp) = True Then If rajet True Then Req Req & " AND "
Req = Req & "(" & temp & ")"
rajet = True
Else
MsgBox "Vous devez selectionner une ou plusieurs activités", vbOKOnly + vbInformation, "Erreur"
Exit Sub
End If
Else
If PersoSelectionnees(temp) = True Then
Req = "(" & temp & ")"
rajet = True
End If
End If
If quel = "Etat des comptes Ech" Then
If Me.ActiAvecEch.Value = -1 Then
If ActiSelectionneesEtat(temp) = True Then If rajet True Then Req Req & " AND "
Req = Req & "(" & temp & ")"
rajet = True
If MsgBox("Désirez-vous Effectuer le calcul des reste à payer ?", vbYesNo + vbQuestion, "Question") = vbYes Then
CalculReste
End If
Else
MsgBox "Vous devez selectionner une ou plusieurs activités", vbOKOnly + vbInformation, "Erreur"
Exit Sub
End If
Else
MsgBox "Vous devez cocher la case 'Que les activitées avec échéancier'", vbOKOnly + vbCritical, "Erreur"
Exit Sub
End If
End If
'Etat des comptes ss ech
If quel = "Etat des comptes ss ech" Then
If ActiSelectionneesEtat(temp) = True Then If rajet True Then Req Req & " AND "
Req = Req & "(" & temp & ")"
rajet = True
If MsgBox("Désirez-vous Effectuer le calcul des reste à payer ?", vbYesNo + vbQuestion, "Question") = vbYes Then
CalculReste
End If
Else
MsgBox "Vous devez selectionner une ou plusieurs activités", vbOKOnly + vbInformation, "Erreur"
Exit Sub
End If
End If
If quel = "Annulation" Then
If Me.QueActiAnnul.Value = -1 Then
If ActiSelectionneesEtat(temp) = True Then If rajet True Then Req Req & " AND "
Req = Req & "(" & temp & ")"
rajet = True
Else
MsgBox "Vous devez selectionner une ou plusieurs activités annulées", vbOKOnly + vbInformation, "Erreur"
Exit Sub
End If
Else
MsgBox "Vous devez cocher la case 'Activités annulées'", vbOKOnly + vbInformation, "Erreur"
Exit Sub
End If
End If
If MetNonAffichable = False Then If rajet True Then Req Req & " AND "
Req = Req & " (Clients.Affichable=YES)"
End If
If MetQueAdhérents = True Then If rajet True Then Req Req & " AND "
Req = Req & " (((Clients.Numadhe) Is Not Null))"
rajet = True
End If
'Debug.Print req
'MsgBox "toto"
'If rajET Then
If quel = "InscritsParActivité" Then
'Debug.Print Src & " Where " & req & ";"
'DoCmd.OpenReport Quel, acPreview, Src & " Where " & Req & ";" ', Req
DoCmd.OpenReport quel, acPreview, , Req
Else
'Debug.Print req
DoCmd.OpenReport quel, acPreview, , Req
End If
' Else
' DoCmd.OpenReport "AccuséRéception", acPreview, Rtat
' End If
Exit Sub
AfficheEtatErr:
MsgBox Err.Description
Exit Sub
End Sub
Private Sub AfficheEtatEtiquette35x70()
'Procedure permettant d'afficher l'etat Etiquette35*70
On Error GoTo AfficheEtatEtiq3570Err
Dim Req As String
Dim temp As String
Dim rajet As Boolean
rajet = False
temp = vbNullString
Req = vbNullString
If PersoSelectionnees(temp) = True Then
Req = "(" & temp & ")"
rajet = True
End If
'If ActiSelectionneesEtat(Temp) = True Then' If rajET True Then req req & " AND "
' req = req & "(" & Temp & ")"
' rajET = True
'End If
If MetNonAffichable = False Then If rajet True Then Req Req & " AND "
Req = Req & " (Clients.Affichable=YES)"
End If
If MetQueAdhérents = True Then If rajet True Then Req Req & " AND "
Req = Req & " (((Clients.Numadhe) Is Not Null))"
rajet = True
End If
Exit Sub
AfficheEtatEtiq3570Err:
MsgBox Err.Description
Exit Sub
End Sub
Private Sub AfficheEtatEtiquette(quel As String)
'Procedure permettant d'afficher des etats etiquettes
'passée en parametres; concerne les cartes de membres
'et les atiquettes 35*105
On Error GoTo AfficheEtatEtiqErr
Dim Req As String
Dim temp As String
Dim rajet As Boolean
Dim SelPerso As Boolean
rajet = False
SelPerso = False
temp = vbNullString
Req = vbNullString
If PersoSelectionnees(temp) = True Then
Req = "(" & temp & ")"
rajet = True
SelPerso = True
End If
'If ActiSelectionneesEtat(Temp) = True Then' If rajET True Then req req & " AND "
' req = req & "(" & Temp & ")"
' rajET = True
'End If
If MetNonAffichable = False Then If rajet True Then Req Req & " AND "
Req = Req & " (Clients.Affichable=YES)"
rajet = True
End If
If quel = "Carte35x70G" Then
'pour les cartes d'adherents
If MetQueAdhérents = False Then
MsgBox "Vous devez cocher la case ""Que les adherents""", vbOKOnly + vbInformation, "Attention"
Exit Sub
End If
End If
If MetQueAdhérents = True Then If rajet True Then Req Req & " AND "
Req = Req & " (((Clients.Numadhe) Is Not Null))"
rajet = True
End If
'req = "Clients.Numadhe Is Not Null"
'Debug.Print Rtat
'Debug.Print req
'DoCmd.OpenReport QueL, acPreview, , req
'MajDerniers quel, Req
If ActiSel = False Then
DoCmd.OpenReport quel, acPreview, Rtat, Req
Else
quel = quel & "CliFact"
'MsgBox quel
DoCmd.OpenReport quel, acPreview, Rtat, Req
'Select Case QueL
'Case "Adresse35x70"
'Adresse35x70CliFact
End If
Exit Sub
AfficheEtatEtiqErr:
MsgBox Err.Description
Exit Sub
End Sub
Private Sub MajDerniers(quel, Req As String)
'2 cas Ajout ou modif
'On Error GoTo MajDerErr
Dim RsPers As Recordset
Dim RsAssoc As Recordset ' contenu de dejafait
Dim Reqete As String
Dim RefEtat As Long
Dim RefPers As Long
Dim Trouve As Boolean
Reqete = Left(Rtat, Len(Rtat) - 1) & " AND " & Req
Set RsPers = CurrentDb.OpenRecordset(Reqete)
Select Case quel
Case "AccuséRéception" '1 refetat
RefEtat = 1
Case "Adresse35x70" '2
RefEtat = 2
Case "Adresse37x105" '3
RefEtat = 3
Case "Carte35x70G" '4
RefEtat = 4
End Select
Reqete = "select * from DejaFait where refEtat=1" '& RefEtat & ";"
Set RsAssoc = CurrentDb.OpenRecordset(Reqete)
'RsPers.MoveFirst
'RsAssoc.MoveFirst
'MsgBox "toto"
RsAssoc.MoveLast
'MsgBox RsAssoc.RecordCount
While Not RsPers.EOF
RefPers = RsPers!refpersonne
RsAssoc.MoveFirst
Trouve = False
While Not RsAssoc.EOF
If RefPers = RsAssoc!refpersonne Then
Trouve = True
If RsAssoc!DejaFait = False Then
RsAssoc.Edit
RsAssoc!DejaFait = True
RsAssoc.Update
End If
End If
RsAssoc.MoveNext
Wend
If Not Trouve Then
RsAssoc.AddNew
RsAssoc!refpersonne = RefPers
RsAssoc!RefEtat = RefEtat
RsAssoc!DejaFait = True
RsAssoc.Update
End If
RsPers.MoveNext
Wend
Exit Sub
MajDerErr:
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub AffEtatCalc()
On Error GoTo AffEtatCalcErr
Dim temp As String
Dim Req As String
If ActiSelectionneesEtat(temp) = True Then
Req = temp
DoCmd.OpenForm "calculs", acNormal, , , , , Req
Else
MsgBox "Vous devez sélectionner une ou plusieurs activités", vbOKOnly + vbCritical, "Erreur"
Exit Sub
End If
Exit Sub
AffEtatCalcErr:
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub CalculReste()
On Error GoTo CalculsErr
Dim Req As String
Dim QelleFact As Long
Dim Reste As Double
Dim Apaye As Double
Dim temp As String
'ActiSelectionnees
Dim Rs As Recordset
Dim RsVers As Recordset
Req = "SELECT Factures.* FROM Factures Where "
If ActiSelectionnees(temp) = True Then
Req = Req & temp
End If
Set Rs = CurrentDb.OpenRecordset(Req)
While Not Rs.EOF
Apaye = 0
Req = "SELECT Versements.* FROM Versements WHERE (((Versements.RefFacture)="
Req = Req & Rs![NuméroFact] & "));"
Set RsVers = CurrentDb.OpenRecordset(Req)
While Not RsVers.EOF
Apaye = Apaye + CDbl(RsVers!Versement)
RsVers.MoveNext
Wend
Rs.Edit
Rs!ResteDu = Rs!Prix - Apaye
Rs.Update
'Reste = Me.Prix - Apaye
Rs.MoveNext
Wend
Exit Sub
CalculsErr:
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub EnRetard(quel As String)
'Procedure permetant de retrouver les personnes
'en retard sur leurs échéances, pour les activités selectionnées
'Ouvre l'état correspondant
On Error GoTo RetardErr
Dim RsEch As Recordset
Dim RsAct As Recordset
Dim Rsdu As Recordset
Dim RsTmp As Recordset
Dim LaDate As Date
Dim laReq As String
Dim temp As String
Dim TotalEcheances As Double
CurrentDb.Execute "Delete * from TempEcheance"
LaDate = Date
'MsgBox LaDate
laReq = "Select refacti from Activites where " 'refacti=4077;"
If Me.ActiAvecEch.Value = -1 Then
If ActiSelectionneesEtat(temp) = True Then
laReq = laReq & "(" & temp & ")"
If MsgBox("Désirez-vous Effectuer le calcul des reste à payer ?", vbYesNo + vbQuestion, "Question") = vbYes Then
CalculReste
End If
Else
MsgBox "Vous devez selectionner une ou plusieurs activités", vbOKOnly + vbInformation, "Erreur"
Exit Sub
End If
Else
MsgBox "Vous devez cocher la case 'Que les activitées avec échéancier'", vbOKOnly + vbCritical, "Erreur"
Exit Sub
End If
'If ActiSelectionneesEtat(temp) = True Then
'
' Else
'End If
Set RsAct = CurrentDb.OpenRecordset(laReq)
Set RsTmp = CurrentDb.OpenRecordset("TempEcheance")
While Not RsAct.EOF
laReq = "Select Echeance.ValeurEcheance from Echeance where [RefActivité]=" & RsAct!refacti & " and DateEcheance<DateValue(""" & LaDate & """) order by DateEcheance ASC;"
Set RsEch = CurrentDb.OpenRecordset(laReq)
TotalEcheances = 0
While Not RsEch.EOF
TotalEcheances = TotalEcheances + RsEch!ValeurEcheance
RsEch.MoveNext
Wend
'MsgBox TotalEcheances
laReq = "SELECT Factures.refpersonne, Factures.refacti, Factures.NuméroFact, First(Factures.Prix) AS PremierDePrix, Sum(Versements.Versement) AS SommeDeVersement" laReq laReq & " FROM (Activites INNER JOIN Factures ON Activites.refacti Factures.refacti) LEFT JOIN Versements ON Factures.NuméroFact = Versements.RefFacture" laReq laReq & " Where Factures.refacti " & RsAct!refacti
laReq = laReq & " GROUP BY Factures.refpersonne, Factures.refacti, Factures.NuméroFact"
laReq = laReq & " HAVING (((Sum(Versements.Versement)) < First([Factures].[Prix]) Or (Sum(Versements.Versement)) Is Null))"
laReq = laReq & " ORDER BY Factures.refpersonne, Factures.refacti;"
Set Rsdu = CurrentDb.OpenRecordset(laReq)
While Not Rsdu.EOF
If TotalEcheances > 0 Then
'l'échéancier existe
'recherche les versements si somme <> null et >0
If Not IsNull(Rsdu!SommeDeVersement) Then
If Rsdu!SommeDeVersement > 0 Then
If Rsdu!SommeDeVersement < TotalEcheances Then
RsTmp.AddNew
RsTmp!refFAct = Rsdu!NuméroFact
RsTmp!ResteAPayer = TotalEcheances - Rsdu!SommeDeVersement
RsTmp!Echéancier = -1
RsTmp.Update
End If
Else
'doit toutes les échéances courues
RsTmp.AddNew
RsTmp!refFAct = Rsdu!NuméroFact
RsTmp!ResteAPayer = TotalEcheances
RsTmp!Echéancier = -1
RsTmp.Update
End If
Else
'doit toutes les échéances courues
RsTmp.AddNew
RsTmp!refFAct = Rsdu!NuméroFact
RsTmp!ResteAPayer = TotalEcheances
RsTmp!Echéancier = -1
RsTmp.Update
End If
Else
'pas d'échéancier
'doit qque chose
RsTmp.AddNew
RsTmp!refFAct = Rsdu!NuméroFact
If IsNull(Rsdu!SommeDeVersement) Then
RsTmp!ResteAPayer = Rsdu!PremierDePrix
Else
RsTmp!ResteAPayer = Rsdu!PremierDePrix - Rsdu!SommeDeVersement
End If
RsTmp!Echéancier = 0
RsTmp.Update
End If
Rsdu.MoveNext
Wend
RsAct.MoveNext
Wend
RsTmp.Close
DoCmd.OpenReport quel, acPreview
Exit Sub
RetardErr:
MsgBox Err & " " & Err.Description
Exit Sub
End Sub
Private Sub Fermer_Click()
On Error GoTo Err_Fermer_Click
