Problème résultat fonction personnalisée

**MarcelG** · 19/01/2018, 14h39

Bonjour le Forum, et Bonne Année à tous.

Tout bête.

J'ai créé une fonction personnalisée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function Is_Férié(ladate As Date) As Boolean
Application.Volatile
Dim rgt As Range
Set rgt = Range("liste_jours_fériés").Find(ladate, LookIn:=xlFormulas)
Is_Férié = Not rgt Is Nothing
Set rgt = Nothing
End Function

Si je l'utilise dans le VBE, alors le résultat est exact
Si je l'utilise dans ma feuille de calcul, alors le résultat est faux

En A11 : 01/01/2018
En A12 : 02/01/2018

VBE

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub essai_fnct()
Debug.Print "A11 : " & Is_Férié(Range("A11"))
Debug.Print "A12 : " & Is_Férié(Range("A12"))
End Sub

Fenêtre Exécution

A11 : Vrai
A12 : Faux

Mais si j'écris dans ma feuille de calcul

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Is_Férié(A11)

Alors le résultat est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
FAUX

Quelque chose doit m'échapper....

D'avance Merci.

**eriiic** · 19/01/2018, 14h55

Bonjour,

pourquoi une fonction personnalisée ? Volatile inutilement d'ailleurs si tu lui passais les paramètres qui vont bien.
Tu ne peux pas voir si ta date est présente avec nb.si() tout simplement ?
eric

**MarcelG** · 19/01/2018, 15h00

Bonjour Eric et Merci,

Je sais qu'il y a des solutions de contournement (code déjà écrit sur ce forum et ailleurs, fonctions date...)
Je les utiliserai.

Mais pourquoi ICI j'ai cette différence avec CE code?

**Phil Free** · 19/01/2018, 15h43

Bonjour,

/!\ attention /!\ la fonction find recherche toujours une chaine !

de plus le format date d'une cellule contient l'heure même si ce n'est pas affiché dans ta cellule. c'est du genre 01/01/2018 01:00:00

donc ce qui suit doit fonctionner :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rgt = Range("liste_jours_fériés").Find(CStr(ladate), LookIn:=xlValues)

**eriiic** · 19/01/2018, 15h44

.find est très particulier avec les dates.
J'avais déjà remarqué son coté schizophrène selon si une fonction est appelée en vba, ou depuis une feuille où il devient sensible au format date (bien que avec LookIn:=xlFormulas)
Je n'ai pas trouvé d'autre solution que de faire 2 traitements, toutes mes tentatives pour un traitement unique sont restées vaines :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Function Is_Férié(ladate As Date) As Boolean
    Application.Volatile
    Dim rgt As Range, appelVBA As Boolean
    On Error Resume Next
    If Not Application.Caller.Parent.Type = xlWorksheet Then appelVBA = True
    On Error GoTo 0
 
    If appelVBA Then
        Set rgt = Range("liste_jours_fériés").Find(ladate, LookIn:=xlFormulas)
    Else
        Set rgt = Range("liste_jours_fériés").Find(Format(ladate, "Short Date"), LookIn:=xlFormulas)
    End If
    Is_Férié = Not rgt Is Nothing
    Set rgt = Nothing
End Function

Fait-moi plaisir, passe-lui en paramètre la plage liste_jours_fériés pour enlever ce .volatile ;-)

**Phil Free** · 19/01/2018, 15h52

Ah oui bien vu eriiic,

Format(ladate, "Short Date") permet de ne récupérer que la partie date du format date d'une cellule qui
comme dit plus haut ressemble à un truc du genre 01/01/2018 01:00:00

**MarcelG** · 22/01/2018, 13h43

Bonjour à vous, Bonjour au Forum,

Merci pour vos réponses.

Eric,

J'ai testé ton code.
Sur Excel 2010, il semblerait que la propriété

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Parent

ne puisse pas être affectée à la méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Caller

que je ne connaissais pas.

En saisie semi-automatique, aucune méthode ni propriété ne peuvent être saisies.
Plus trivialement, après le ".", rien n'est proposé.

MAIS

Le code fonctionne.

1 remarque
Si je code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

appelVBA = Not (Application.Caller.Parent.Type = xlWorksheet)

alors le code n'est pas fonctionnel
?

Enfin,
Je ne vois pas ce que tu entends par

Fait-moi plaisir, passe-lui en paramètre la plage liste_jours_fériés pour enlever ce .volatile ;-)

En tout cas, merci.

Invité · 22/01/2018, 13h55

Bonjour Marcel,

Code Calendrier perpetuel :

Sélectionner tout - Visualiser dans une fenêtre à part

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
' Cette fonction renvoie Vrai si la date transmise est un jour férié
' fixe ou mobile
' les lundis de pâques sont calculés
Public Function RetourneDate(M As String, Annee As String) As Date
Dim moi
moi = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
For I = 1 To 12
If UCase("" & moi(I)) = UCase("" & M) Then Exit For
Next
RetourneDate = "01/" & Format(I, "00") & "/" & Annee
End Function
Function Ferie(UneDate As Long) As Boolean
' Par défaut la fonction ne considère pas que les Dimanche de Pâques
' et de Pentecôte sont fériés
' il suffit de renseigner l'argument DimanchesOuiNon à True à l'appel de la fonction
' pour les considérer comme fériés
Ferie = IsDimange(UneDate)
If Ferie = True Then Exit Function
Dim JFF ' table des fériés fixes (jours)
Dim MFF ' table des fériés fixes (mois)
JFF = Array(1, 1, 8, 14, 15, 1, 11, 25)
MFF = Array(1, 5, 5, 7, 8, 11, 11, 12)
Dim J As Long
Ferie = False
' Recherche dans la table des jours fériés fixes
For J = 0 To 7
If Day(UneDate) = JFF(J) And Month(UneDate) = MFF(J) Then
Ferie = True
Exit Function
End If
Next J
Dim FM ' contient les dates des lundis de Paques
'FM = Array(38824, 39181, 39531, 39916, 40273, 40658, 41008, _
'41365, 41750, 42100, 42457, 42842, _
'43192, 43577, 43934, 44291, 44675, _
'45026, 45383, 45768, 46118, 46475, _
'46860, 47210, 47595)
 
 
FM = Paque(Year(UneDate))
' Recherche si la date est un lundi de paques
' ou jeudi de l'ascension
' ou lundi de pentecôte
'For J = 0 To 24 ' à changer si vous allez au delà de 2030
If (UneDate = FM) Or (UneDate = FM + 39) Or (UneDate = FM + 50) Then
Ferie = True
Exit Function
End If
' si DimanchesOuiNon est vrai
' on teste les dimanches de Pâques et Pentecote
 
 
 
 
If DimanchesOuiNon Then
If (UneDate = FM - 1) Or (UneDate = FM + 48) Then
Ferie = True
Exit Function
End If
End If
'Next J
End Function
Function IsDimange(J) As Boolean
 
 
If Weekday(J) = 1 Or Weekday(J) = 7 Then IsDimange = True
End Function
Function MDDIF(A, B) As Long
MDDIF = DateDiff("d", A, B)
End Function
Function MuMod(V, D)
MuMod = Int(V / D)
End Function
Function Paque(Annee As Integer) As Date
Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, O
C = Annee - 1900
D = C Mod 19
E = (D * 7) + 1
F = Int(E / 19)
G = 11 * D - F + 4
H = G Mod 29
I = Int(C / 4)
J = C - H + I + 31
L = J Mod 7
K = J Mod 7
L = 25 - H - K
M = CDate("31/03/" & Annee)
Paque = M + L
End Function
Sub E()
Debug.Print Paque(2014)
 
 
End Sub
 
 
Public Function TemPTravaiL(B, Mois As String, T As String)
Dim moi
moi = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
For I = 1 To 12
If UCase("" & moi(I)) = UCase("" & Mois) Then Exit For
Next
TemPTravaiL = [TMP]
If UCase("" & moi(Month(B))) <> UCase("" & moi(I)) Then
    TemPTravaiL = "00:00"
    Exit Function
End If
If Weekday(B) = 1 Or Weekday(B) = 7 Then
TemPTravaiL = "00:00"
    Exit Function
End If
If Ferie(CLng(B), True) = True Then TemPTravaiL = vbNull: Exit Function
TemPTravaiL = T
'SI(NB.JOURS.OUVRES(B8;B8)=0;"";TMP))
End Function

**MarcelG** · 22/01/2018, 13h58

Bonjour et merci, Dysorthographie.
Comme Eric,

**patricktoulon** · 22/01/2018, 14h04

re

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set rgt = Range("liste_jours_fériés").Find(ladate, LookIn:=xlFormulas)
Is_Férié = Not rgt Is Nothing

il y a peut etre mauvaise interprétation pour le "ladate" ajouter le format ou chercher le .value en texte de date

il est possible qu'il n'y est pas de callback donc ta 2d ligne ne peut pas fonctionner il faut peut etre tester le nothing en amont

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
if  not rgt is nothing then
Is_Férié =true
else
....
end if

sans le parent devant range meme si c'est une plage nommée est ce que en mode excel elle est reconnue ?

meilleur veux marcelG au fait

**MarcelG** · 22/01/2018, 14h14

Bonjour Patrick,

Ravi de te retrouver.
Meilleurs vœux également.
(Désolé de n'être pas plus actif sur le Forum)

Je teste ces pistes et reviens,
au plus vite...

**Docmarti** · 22/01/2018, 15h20

Bonjour.

Fais les 2 tests qu'importe la version de Excel ou le parent.caller.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
    what = CDate(ladate)
    Set rgt = Range("liste_jours_fériés").Find(what:=what, LookIn:=xlFormulas, lookat:=xlPart)
    If rgt Is Nothing Then
        what = CStr(DateValue(ladate))
        Set rgt = Range("liste_jours_fériés").Find(what:=what, LookIn:=xlFormulas, lookat:=xlPart)
    End If

Invité · 22/01/2018, 16h08

avec le code de mon calendrier perpétuel!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub test()
MsgBox  Ferie(CDate("01/01/2017")) 
MsgBox  Ferie(CDate("02/01/2017")) 
End Sub

Code tu oublis ça : Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
what = CDate(ladate) Set rgt = Range("liste_jours_fériés").Find(what:=what, LookIn:=xlFormulas, lookat:=xlPart) If rgt Is Nothing Then what = CStr(DateValue(ladate)) Set rgt = Range("liste_jours_fériés").Find(what:=what, LookIn:=xlFormulas, lookat:=xlPart) EndIf

**eriiic** · 22/01/2018, 17h59

Bonjour,

Sur Excel 2010, il semblerait que ... MAIS Le code fonctionne.

C'est bien pour ça que je l'ai écrit comme ça ;-)
2010 aussi pour moi.
eric

**Docmarti** · 22/01/2018, 18h18

Le code d'Eric

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    If appelVBA Then
        Set rgt = Range("liste_jours_fériés").Find(ladate, LookIn:=xlFormulas)
    Else
        Set rgt = Range("liste_jours_fériés").Find(Format(ladate, "Short Date"), LookIn:=xlFormulas)
    End If

demontre que le parametre What doit etre de type String si l'appelant est la feuille et doit etre de type Date si l'appelant est VBA.

C'est interessant.

**eriiic** · 22/01/2018, 19h54

Oui, j'ai l'impression que les conversions entre excel et vba, internes à vba, en passant parfois par les paramètres régionaux et les formats sur feuille font un vrai plat de spaghetti indémêlable...

Invité · 27/01/2018, 23h18

Bonsoir Pierre,
Je travail en prestation depuis 20 ans et je ne rempli jamais mes feuilles d'heures,
J'ai un onglet ou je rentre mon premier et dernière jour de conges et tous les mois ma feuille d'heures se remplit automatiquement!

Les jours de congés ne sont pas si fréquent que cela et son plus par plages, un jour ça arrive mais c'est plus rare!

Ça fait quinze ans que je l'utilise!

Invité · 27/01/2018, 21h10

Bonsoir,
Je rappel qu'au poste #8 je fourni un code et un classeur qui trouve si un jour est férié ou non grasse à un calendrier perpétuel! Pas besoin de définir dans un onglets les jours fériés!

Maintenant j'avais compris que Marcel cherchais une réponse concernant la fonction find pas une autres solutions!

**Pierre Fauconnier** · 27/01/2018, 21h34

Envoyé par dysorthographie

[...]Pas besoin de définir dans un onglets les jours fériés![...]

L'avantage du tableau, c'est qu'il permet d'ajouter des jours qui ne sont pas fériés légaux mais bien des jours de congé d'entreprise ou autre. Ca étend le champ des possibilités, comme le code des jours travaillés dans la semaine... Mais bien sûr, il faut remplir le tableau...

Chaque solution a donc ses avantages et ses inconvénients

**Pierre Fauconnier** · 22/01/2018, 17h54

Salut.

Je sais que ta question initiale concerne un problème vba que tu ne t'expliques pas, mais je réponds quand même

Nul besoin de VBA pour tester si une date est ouvrée ou non... Je l'explique dans mon billet de blog sur le sujet.

Formule pour savoir si un jour saisi en A4 est ouvré ou pas, sur base du tableau des jours fériés t_JoursFériés

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(NB.JOURS.OUVRES.INTL(A4;A4;$B$1;t_JoursFériés)>0;"Ouvré";"Férié")

Problème résultat fonction personnalisée [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager