Problémes de recherchedans une table

Question

BOnjour,

voici mon prolbèmeme:

J'ai adapté un code de fonction de calcul du nombre de jours ouvrées qui fait appel à une sous fonction de verification de jours feriés.


Dans cette sous fonction, on trouve les jours fériées calendaires, mais j'aimerais également rechercher des jours feriées dans une table (Ponts/Vacances, avec deux champs l'un de numérotation, l'autre contenant les date au format jj.mm.aaaa), ceux ci correspondent en effet aux vacances. 
En gros si la date se trouve dans la table le jour est consideré comme ferié.J'ai réalisé ceci à l'aide de la méthode seek.
Malheuresement mon code ne me considère pas les dates de la table comme feriés. 
Je débute en code et en accèss donc pardonné d'avance mon peu de connaissances.

Merci d'avance !

Beber

P.S : Mon code (en gras là ou cela pose problème)

Function nbjourouvrable(datdeb, datfin)

If datdeb "" Or datfin "" Then Exit Function


nbjourtot = DateDiff("d", datdeb, datfin) + 1



For I = 1 To nbjourtot



  If ferie(datdeb) Then

    nbjourtot = nbjourtot - 1

  End If



 datdeb = DateAdd("d", 1, datdeb)



Next



nbjourouvrable = nbjourtot



End Function



Function ferie(Jour)

If Jour = "" Then Exit Function

Dim JJ, AA

Dim NbOr, Epacte

Dim PLune, Paques, Ascension, Pentecote, LPaques, FDieu

Dim Journee As String


JJ = Day(Jour)

mm = Month(Jour)

AA = Year(Jour)

' Suppression des jours feriés calendaires jurassien


If JJ 1 And mm 1 Then ferie = True: Exit Function     '1 Janvier

If JJ 1 And mm 5 Then ferie = True: Exit Function     '1 Mai

If JJ 23 And mm 6 Then ferie = True: Exit Function     '23 Juin

If JJ 1 And mm 8 Then ferie = True: Exit Function   '1 Août

If JJ 15 And mm 8 Then ferie = True: Exit Function   '15 Août

If JJ 1 And mm 11 Then ferie = True: Exit Function '1 Novembre

If JJ 25 And mm 12 Then ferie = True: Exit Function '25 Décembre



NbOr = (AA Mod 19) + 1

Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30

PLune = CDate("19/04/" & AA) - ((Epacte + 6) Mod 30)

If Epacte 24 Then PLune PLune - 1

If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1



Paques = PLune - Weekday(PLune) + vbMonday + 7  'Paques

If JJ Day(Paques) And mm Month(Paques) Then ferie = True: Exit Function
If JJ Day(Paques + 1) And mm Month(Paques) Then ferie = True: Exit Function 'Lundi de Pâques
If JJ Day(Paques - 2) And mm Month(Paques) Then ferie = True: Exit Function 'Vendredi de Pâques



Ascension = Paques + 38 'Ascension

If JJ Day(Ascension) And mm Month(Ascension) Then ferie = True: Exit Function



Pentecote = Ascension + 11 'Pentecote

If JJ Day(Pentecote) And mm Month(Pentecote) Then ferie = True: Exit Function
If JJ Day(Pentecote + 1) And mm Month(Pentecote) Then ferie = True: Exit Function 'Lundi de pentecote

FDieu = Paques + 60
If JJ Day(FDieu) And mm Month(FDieu) Then ferie = True: Exit Function

ferie = False

' Suppression des Samedis et Dimanches


Dim numjour

numjour = Weekday(Jour, vbMonday)   'fixe à 6 et 7 la valeur du samedi & dimanche

If numjour 6 Or numjour 7 Then ferie = True: Exit Function


' Suppression des dates entrées dans la table Ponts/Vacances


Dim dbs As Database
Dim strdate As DAO.Recordset


Set dbs = CurrentDb

Set strdate = dbs.OpenRecordset("Ponts/Vacances", dbOpenTable)


[b]With strdate
  .Index = "PrimaryKey"
  
  .Seek "=", Jour
  
  If .NoMatch Then
    ferie = False: Exit Function
                Else
    ferie = True: Exit Function
    
  End If/b  
  
End With
        


End Function

cs_Jack · Answer

Salut

-1- Si tu travailles sous Access, c'est du VBA, pas du VB6 (pour ta prochaine question, choisi bien la catégorie, cela peut influencer les réponses)

-2- La prochaine fois, utilise la colorisation syntaxique (3ème icone à partir de la droite) pour coller ton code : cela gardera le format de l'indentation (décalage de la gauche) + colorisera les noms des fonctions =  Beaucoup plus facile à lire et à décortiquer (merci pour les lecteurs).

-3- Que vaut ta variable Jour au moment du Seek ?
Il faudra surement la remettre au format date US (MM/DD/YYYY) pour pouvoir faire des recherches aux conditions expresses que :
- Ta date soit une clé primaire de ta table
- Ta date soit déclarée  dans ta DB  comme une donnée de type Date

-4- Rappel : DAO est obsolète, dépassé
Mieux vaut utiliser ADO pour ce genre de recherche.

Vala
Jack, =fr MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

mibolti · Answer

Salut,

desoler pour mes erruers de syntaxe sur le forum je conais pas grand grand chose à tous ça.

Concernant ta demande, ma variable jour est du type jj.mm.aaaa (format date dans acces)

La variable jour est issu d'une requête aui cherche le jour dans une table ou il est en format jj.mm.aaaa

Concernant la declaration de type date je ne vois pas comment faire cela, pourrais tu me guider?

Enfin, concernant la difference entre DAO et ADO je n'en savais rien vu que c'est la premiere fois que je touche à acces désolé...

Merci d'avance

mibolti · Answer

Mon code en couleur :

Function nbjourouvrable(datdeb, datfin) 

If datdeb "" Or datfin "" Then Exit Function 


nbjourtot = DateDiff("d", datdeb, datfin) + 1 



For I = 1 To nbjourtot 



If ferie(datdeb) Then 

nbjourtot = nbjourtot - 1 

End If 



datdeb = DateAdd("d", 1, datdeb) 



Next 



nbjourouvrable = nbjourtot 



End Function 



Function ferie(Jour) 

If Jour = "" Then Exit Function 

Dim JJ, AA 

Dim NbOr, Epacte 

Dim PLune, Paques, Ascension, Pentecote, LPaques, FDieu 

Dim Journee As String 


JJ = Day(Jour) 

mm = Month(Jour) 

AA = Year(Jour) 

' Suppression des jours feriés calendaires jurassien 


If JJ 1 And mm 1 Then ferie = True: Exit Function '1 Janvier 

If JJ 1 And mm 5 Then ferie = True: Exit Function '1 Mai 

If JJ 23 And mm 6 Then ferie = True: Exit Function '23 Juin 

If JJ 1 And mm 8 Then ferie = True: Exit Function '1 Août 

If JJ 15 And mm 8 Then ferie = True: Exit Function '15 Août 

If JJ 1 And mm 11 Then ferie = True: Exit Function '1 Novembre 

If JJ 25 And mm 12 Then ferie = True: Exit Function '25 Décembre 



NbOr = (AA Mod 19) + 1 

Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30 

PLune = CDate("19/04/" & AA) - ((Epacte + 6) Mod 30) 

If Epacte 24 Then PLune PLune - 1 

If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1 



Paques = PLune - Weekday(PLune) + vbMonday + 7 'Paques 

If JJ Day(Paques) And mm Month(Paques) Then ferie = True: Exit Function 
If JJ Day(Paques + 1) And mm Month(Paques) Then ferie = True: Exit Function 'Lundi de Pâques 
If JJ Day(Paques - 2) And mm Month(Paques) Then ferie = True: Exit Function 'Vendredi de Pâques 



Ascension = Paques + 38 'Ascension 

If JJ Day(Ascension) And mm Month(Ascension) Then ferie = True: Exit Function 



Pentecote = Ascension + 11 'Pentecote 

If JJ Day(Pentecote) And mm Month(Pentecote) Then ferie = True: Exit Function 
If JJ Day(Pentecote + 1) And mm Month(Pentecote) Then ferie = True: Exit Function 'Lundi de pentecote 

FDieu = Paques + 60 
If JJ Day(FDieu) And mm Month(FDieu) Then ferie = True: Exit Function 

ferie = False 

' Suppression des Samedis et Dimanches 


Dim numjour 

numjour = Weekday(Jour, vbMonday) 'fixe à 6 et 7 la valeur du samedi & dimanche 

If numjour 6 Or numjour 7 Then ferie = True: Exit Function 


' Suppression des dates entrées dans la table Ponts/Vacances 


Dim dbs As Database 
Dim strdate As DAO.Recordset 


Set dbs = CurrentDb 

Set strdate = dbs.OpenRecordset("Ponts/Vacances", dbOpenTable) 


With strdate 
.Index = "PrimaryKey" 

.Seek "=", Jour 

If .NoMatch Then 
ferie = False: Exit Function 
Else 
ferie = True: Exit Function 

End If 

End With 



End Function

Problémes de recherchedans une table

3 réponses

Votre réponse

Discussions similaires