Fonction personnalisée s'exécute deux fois

[ThierryP]

Bonjour le forum et Denis,

J'ai créé une fonction personnalisée qui calcule les N° de semaines d'un mois.

Dans le WorkBook_Open, j'ai :
Range("S_Sem_Mois") = "De la semaine " & Calcul_SemainesDuMois(Date).Premier & " à la semaine " & Calcul_SemainesDuMois(Date).Dernier

J'ai créé une structure :
Public Type Semaine
Premier As Integer
Dernier As Integer
End Type
Et ma fonction :
Function Calcul_SemainesDuMois(Jour) As Semaine
Mois = Month(Jour)
Calcul_SemainesDuMois.Premier = NumSemaine(DateSerial(Range("Année"), Mois, 1))
Select Case Mois
Case 1, 3, 5, 7, 8, 10, 12
J = 31
Case 2
J = IIf(Bissextile(Range("Année")), 29, 28)
Case 4, 6, 9, 11
J = 30
End Select
Calcul_SemainesDuMois.Dernier = NumSemaine(DateSerial(Range("Année"), Mois, J))
End Function
La fonction NumSemaine :
Function NumSemaine(D As Date) As Long
D = Int(D)
NumSemaine = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
NumSemaine = ((D - NumSemaine - 3 + (Weekday(NumSemaine) + 1) Mod 7)) \ 7 + 1
End Function
Mon souci est que la fonction Calcul_SemainesDuMois s'exécute deux fois.... et je ne sais pas pourquoi !
J'ai essayé de placer un Exit Function mais ça ne change rien.

Si quelqu'un a une explication, je prend !!!
Merci d'avance,

ThierryP

[MichD]

Le 29/04/22 à 04:36, ThierryP a écrit :

Bonjour,

A ) les fonctions vont dans un module standard. Tu peux les placer dans
un module feuille, si une procédure de ce module requiert exclusivement
cette fonction.

B ) je ne comprends pas ce que tu veux obtenir, tu utilises des
"expressions" dans les fonctions qui n'ont rien à voir avec le VBA.

Une fonction pour déterminer si une année est bissextile ou non :

Pour qu'une année soit bissextile, elle doit respecter 2 conditions :
Le mois de cette année doit avoir 29 jours.
L'année 1900 n'est pas bissextile, on le teste par :
Application.mod(Année, 400) = 0

'---------------------------
Function EstBissextile(MaDate As Date) As Boolean
Dim Année As Long, Mois As Long
Année = Year(MaDate)
Mois = Month(MaDate)

If Day(DateSerial(Année, Mois + 1, 0)) = 29 Then
If Right(Année, 2) = "00" Then
If Application.mod(Année, 400) = 0 Then
EstBissextile = True
Else
EstBissextile = True
End If
Else
EstBissextile = True
End If
End If
End Function
'---------------------------

Pour connaître la semaine d'une date dans l'année, tu fonction :

Pour une version Microsoft Office 2016 ou plus récent :
'---------------------------
Function NumSemaine(MaDate As Date)
NumSemaine = Application.IsoWeekNum(MaDate)
End Function
'---------------------------

Pour toutes les versions d'Excel :
'---------------------------

Function NumSemaine(D As Date) As Long
D = Int(D)

NumSemaine = DateSerial(Year(D + (8 - _

Weekday(D)) Mod 7 - 3), 1, 1)

NumSemaine = ((D - NumSemaine - 3 + _

(Weekday(NumSemaine) + 1) Mod 7)) \ 7 + 1
End Function

'---------------------------

Ces 2 fonctions peuvent être appelées par une procédure en VBA ou
directement dans une cellule de la feuille de calcul.

Le paramètre "MaDate" ou "D" peuvent être le contenu d'une cellule ayant
une date reconnue comme telle par Excel.

Ces fonctions seront appelées seulement si le contenu de la cellule
passée en paramètre est modifié.

MichD

[MichD]

Le 29/04/22 à 07:47, MichD a écrit :

La fonction NumSem() est à la norme européenne.

MichD

[MichD]

Le 29/04/22 à 04:36, ThierryP a écrit :

Fonction pour déterminer la semaine d'une date particulière du mois:

'-------------------------
Function SemaineDuMois(D As Date) As Long

SemaineDuMois = Int((Day(Date) - 1) / 7) + 1

End Function
'-------------------------

MichD

[ThierryP]

Bonjour Denis,

Je n'ai pas de souci avec mes fonctions personnalisées, mon souci c'est que quand j'appelle ma fonction Calcul_SemainesDuMois, elle s'exécute deux fois et ce même si j'ajoute un Exit Function juste avant le End Function : en pas à pas, je passe sur le "Exit Function" mais la fonction s'exécute une deuxième fois et seulement après ça je retourne sur la macro appelante.

En soi, ce n'est pas très gênant mais j'aime bien comprendre les choses !

ThierryP

[MichD]

Le 29/04/22 à 04:36, ThierryP a écrit :

Explique-moi ces expressions :
Calcul_SemainesDuMois(Date).Dernier
Calcul_SemainesDuMois.Premier

J = IIf(Bissextile(Range("Année")), 29, 28)

Dans ta fonction, tu appelles 2 fois la même fonction

Calcul_SemainesDuMois.Premier = NumSemaine(DateSerial(Range("Année"),
Mois, 1))

et

Calcul_SemainesDuMois.Dernier = NumSemaine(DateSerial(Range("Année"),
Mois, J))

Il n'y a rien à comprendre, la fonction s'exécute 2 fois par que tu
l'appelles 2 fois dans la même fonction. Moi, pas savoir pourquoi tu
l'appelles 2 fois.

À chaque fois qu'un contenu de cellule est mis a jour, la fonction
s'exécute.

MichD

[ThierryP]

Re-bonjour,

Ce n'est pas simple à expliquer de manière succinte !
J'ai besoin de connaître le N° de la première et de la dernière semaine du mois en cours. Mon idée était de créer une fonction qui me renvoie d'un coup ces deux valeurs.

Donc, j'ai créé un Type :

Public Type Semaine
Premier As Integer 'Le N° de la première semaine du mois
Dernier As Integer 'Le N° de la dernière semaine du mois
End Type

Dans le WorkBook_Open, j'ai ceci :

Range("S_Sem_Mois") = "De la semaine " & Calcul_SemainesDuMois.Premier & " à la semaine " & Calcul_SemainesDuMois.Dernier, qui appelle effectivement deux fois la fonction, mais je sais pas comment faire autrement !
Ma fonction :

Function Calcul_SemainesDuMois() As Semaine
Mois = Month(Date)
Calcul_SemainesDuMois.Premier = NumSemaine(DateSerial(Range("Année"), Mois, 1)) 'NumSemaine est la fonction de Laurent Longre qui calcule le N° de semaine ISO d'une date donnée
' Je passe 1 en argument pour le premier jour du mois

Select Case Mois
Case 1, 3, 5, 7, 8, 10, 12
J = 31
Case 2

J = IIf(Bissextile(Range("Année")), 29, 28) 'Bissextile est une fonction qui détermine si l'année est bissextile

Case 4, 6, 9, 11
J = 30
End Select

Calcul_SemainesDuMois.Dernier = NumSemaine(DateSerial(Range("Année"), Mois, J)) 'Je passe J en argument pour le dernier jour du mois
End Function

Quand je fais un pas à pas :

- J'arrive sur Function Calcul_SemainesDuMois() As Semaine
- La ligne Calcul_SemainesDuMois.Premier appelle ma fonction NumSemaine
- Je calcule le dernier jour du mois (J)
- Calcul_SemainesDuMois.Dernier = NumSemaine(DateSerial(Range("Année"), Mois, J)) appelle de nouveau ma fonction NumSemaine avec l'argument J
- Je passe sur le End Function

Et là, le pas à pas repasse sur Function Calcul_SemainesDuMois() As Semaine et la fonction s'exécute une deuxième fois ?????
Et je ne vois pas du tout pourquoi..... C'est sûr que mes maigres connaissances en VBA ne m'aident pas, mais j'aimerais comprendre où est-ce que j'ai commis une erreur ?

Merci à toi, bon week-end,

ThierryP

[Geo]

De ThierryP, le 29/04/2022 :

> Range("S_Sem_Mois") = "De la semaine " & Calcul_SemainesDuMois.Premier & " à
> la semaine " & Calcul_SemainesDuMois.Dernier, qui appelle effectivement deux
> fois la fonction, mais je sais pas comment faire autrement ! Ma fonction :

A la limite, ce n'est pas grave, vous devez avoir le résultat attendu.

Sinon, je ferais un truc du genre (pas essayé) :
Dim maSemaine as Semaine
maSemaine = Calcul_SemainesDuMois
Range("S_Sem_Mois") = "De la semaine " & MaSemaine.Premier & " à la
semaine " & MaSemaine.Dernier

[Geo]

De ThierryP, le 29/04/2022 :

> NumSemaine est la fonction de Laurent Longre

Woah ! ça ne date pas d'hier.

[MichD]

Tu pourrais avoir quelque chose comme ceci.

Chacune des fonctions peut être appelée dans une
procédure vba ou dans une cellule de la feuille de calcul.

Désolé, mais je n'ai sûrement pas compris ton propos.

Si une fonction s'exécute 2 fois, c'est qu'elle est appelée 2 fois ou la
cellule contenant la date a été modifiée. As-tu d'autres macros dans ton
projetVBA...


'----------------------------------------
Function PremierJourDuMois(D As Date)

Dim T As Long
T = NumSemaine(DateSerial(Year(D), Month(D), 1))
Select Case Month(D)

Case 1, 3, 5, 7, 8, 10, 12

j = 31

Case 2
J = IIf(Bissextile(Range("Année")), 29, 28)

Case 4, 6, 9, 11

j = 30
End Select
PremierJourDuMois = j
End Function
'----------------------------------------

'----------------------------------------

Function NumSemaine(D As Date) As Long
D = Int(D)
NumSemaine = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
NumSemaine = ((D - NumSemaine - 3 + (Weekday(NumSemaine) + 1) Mod
7)) \ 7 + 1
End Function

'----------------------------------------

Function DerJourDuMois(D As Date)
j = PremierJourDuMois(D)
DerJourDuMois = NumSemaine(DateSerial(Year(D), Month(D), j))
End Function
'----------------------------------------

MichD

[Geo]

De MichD, le 29/04/2022 :

> Si une fonction s'exécute 2 fois, c'est qu'elle est appelée 2 fois

ce qui parait bien le cas :
Range("S_Sem_Mois") = "... " & *Calcul_SemainesDuMois*.Premier & " ...
" & *Calcul_SemainesDuMois*.Dernier

C'est d'ailleurs sans doute la première fois que je vois ce type
d'appel, je n'aurais pas imaginé que cela fonctionne.

[MichD]

Le 29/04/22 à 15:29, Geo a écrit :

Bonjour Geo,

C'est une manière particulière d'écrire du code, ce qui compte c'est le
résultat, il doit être au rendez-vous. Dans Excel, il y a souvent
plusieurs formules différentes qui peuvent être appliquées pour un
problème, il en va de même pour une procédure.

SemainesDuMois*.Premier et SemainesDuMois*.Dernier font appel à la même
fonction, il y a seulement le paramètre de la fonction qui est changé.

Le créateur a toujours raison!

MichD

[MichD]

Pour qu'un fonction retourne les 2 réponses, on fait comme ceci :

Personnellement, c'est que l'on doit saisir la fonction dans la feuille
de calcul comme une fonction matricielle.

Exemple : A1 = Une date
B2 = la formule : =PremierJourDuMois(A1)

Maintenant, sélectionne les cellules B1:B2 tout en ayant la cellule B1
comme cellule active, et tu valides par Ctrl+ Maj + Enter

Dans la déclaration de la fonction, j'ai ajouté "As Variant" afin de
pouvoir affecter le contenu du tableau T à la fonction.

Dans la procédure "PremierJourDuMois", j'ai déclaré T(1 To 2) comme un
tableau (array) pour contenir les 2 réponses attendues.

Voilà!

P.S. Je ne peux pas tester, je ne sais pas le résultat que tu veux obtenir!
'----------------------------------------
Function PremierJourDuMois(D As Date) As Variant

Dim T(1 To 2)
T(1) = NumSemaine(DateSerial(Year(D), Month(D), 1))
Select Case Month(D)

Case 1, 3, 5, 7, 8, 10, 12

j = 31
Case 2

j = IIf(Bissextile(Range("Année")), 29, 28)

Case 4, 6, 9, 11

j = 30
End Select
PremierJourDuMois = j

T(2) = NumSemaine(DateSerial(Year(D), Month(D), j))
PremierJourDuMois = T
End Function

'----------------------------------------

Function NumSemaine(D As Date) As Long
D = Int(D)
NumSemaine = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
NumSemaine = ((D - NumSemaine - 3 + (Weekday(NumSemaine) + 1) Mod
7)) \ 7 + 1
End Function

'----------------------------------------

Ce que je n'ai pas compris :
Est-ce possible que le premier jour du mois peut-être différent de 1 ?

Pour trouver le dernier jour du mois, on peut l'obtenir par cette ligne
de code. (La variable "D" est une date reconnue par Excel.
Msgbox DateSerial(Year(D), Month(D) + 1, 0)

Si tu veux trouver le lundi (début de semaine) d'une date donnée :
En A4 : une date
La formule : =SI(JOURSEM(A4;2)=1;A4;(A4-JOURSEM(A4-2)+7)-7)
Si la date saisie en A4 est un lundi, la date de A4 est retournée

Pour obtenir le vendredi de cette date en A4 dans laquelle se trouve
cette date :
=SI(JOURSEM(A4;2)=1;A4;(A4-JOURSEM(A4-2)+7)-3)

Cela en tenant compte du fait que la première journée de la semaine est
un lundi.

MichD

MichD

[ThierryP]

Bonjour Geo,

Je ne date pas d'hier non plus :-):-) !!!!

ThierryP

[ThierryP]

C'est la première fois qu'on me dit que j'ai imaginé un truc qui ne devrait pas fonctionner mais qui fonctionne quand même :-):-)
En fait, c'est tombé en marche !!!!!!!!!!!!

Merci pour tes remarques, je vais tester !

ThierryP

[ThierryP]

Bonjour Denis,
OK, le créateur a toujours raison, mais seulement si il sait ce qu'il fait !!!
Et surtout, si il comprend ce qu'il fait ....... C'est là mon souci !
Encore merci du retour,

ThierryP

[ThierryP]

Bonjour Denis,

Je crois que ton idée d'Array est la bonne, je testerai ça dès lundi, pour l'instant je profite du week-end :-)

Merci encore pour ton suivi !

Thierry

[ThierryP]

Bonjour Geo,

C'est bien ce que je disais, mes maigres connaissances en VBA sont un handicap !
Pourquoi n'y ai-je pas pensé par moi-même ???
Je vais tester ça dès lundi !

ThierryP

[Geo]

De ThierryP, le 30/04/2022 :

> Pourquoi n'y ai-je pas pensé par moi-même ???

Ben si tout le monde avait toutes les solutions, il n'y aurait plus de
forums.
Et ce serait bien triste.

[ThierryP]

Bonjour Denis,

En fait, j'ai adapté cette fonction que j'avais créée il y a longtemps à un nouveau besoin et je n'ai pas assez réfléchi..... et tu as tout à fait raison, le premier jour du mois est forcément le 1 !!!

Comme dit Geo, l'intérêt des forums c'est aussi qu'un oeil extérieur regarde ce que l'on a pondu !

Merci pour ton temps... et ets explications !

ThierryP