Discussion :

[Bonero]

Bonjour a tous,
J’ai ecrit cette petite function qui soustrait/ajoute un certain nombre de jours(n) d’une date de depart(dtStart). Si le result tombe sur un weekend alors , la function retourne le vendredi d’avant.
Je veux m’assurer que la cellule qui accueille la function soit de type date("m/d/yyyy") pour eviter de le faire manuellement. Pour ce faire, j’utilise Application.Caller mais visiblement cela ne marche pas !!!
Pouvez vous svp me dire la cause de ma bêtise?
Merci

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
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Function fctTMinus(dtStart As Date, n As Byte) As Date
'function qui soustrait/ajoute un certain nombre de jours(n) d'une date de depart(dtStart). _
Si le result tombe sur un weekend alors , la function retourne le vendredi d'avant.
 
    Dim dtTemp As Date
 
    dtTemp = DateAdd("d", -n, dtStart)
 
    'Renvoyer le vendredi d'avant si le result de l'operation donne un weekend.
    Select Case Weekday(dtTemp, vbMonday)
        Case 6
            'Renvoyer le vendredi d'avant si le result tombe sur samedi
            dtTemp = DateAdd("d", -1, dtTemp)
        Case 7
             'Renvoyer le vendredi d'avant si le result tombe sur Dimanche.
             dtTemp = DateAdd("d", -2, dtTemp)
    End Select
 
    'Le resultat final
    fctTMinus = dtTemp
 
    'S'assurer la cellule qui acceuille le result soit du format date ie "m/d/yyyy".
    'CECI NE SEMBLE PAS MARCHER COMME ESCOMPTE !!!!
     If IsObject(Application.Caller) Then
        Application.Caller.NumberFormat = "m/d/yyyy"
    Else
    End If
 
End Function

[casefayere]

Bonsoir,
et ce code ne suffirait pas ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    dtTemp = DateAdd("d", -n, dtStart)
 
    'Renvoyer le vendredi d'avant si le result de l'operation donne un weekend.
    Select Case Weekday(dtTemp, vbMonday)
        Case 6
            'Renvoyer le vendredi d'avant si le result tombe sur samedi
            dtTemp = DateAdd("d", -1, dtTemp)
        Case 7
             'Renvoyer le vendredi d'avant si le result tombe sur Dimanche.
             dtTemp = DateAdd("d", -2, dtTemp)
    End Select
 
    'Le resultat final
    fctTMinus = Format(dtTemp, "m/d/yyyy")

[Docmarti]

Bonjour .

C'est probablement lié aux limitations d'une fonction appelée par une formule.
Il reste par contre l'utilisation de l'événement Worksheet_Change.

Une fonction définie par l'utilisateur appelée par une formule dans une cellule de feuille de calcul ne peut pas modifier l'environnement de Microsoft Excel.
Cela signifie qu'une telle fonction ne peut pas effectuer les opérations suivantes :
Insérer, supprimer ou mettre en forme les cellules de la feuille de calcul.
Modifier la valeur d'une autre cellule.
Déplacer, renommer, supprimer ou ajouter des feuilles à un classeur.
Modifier les options d'environnement, telles que des vues de mode ou de l'écran de calcul.
Ajouter des noms dans un classeur.
Définir des propriétés ou exécuter la plupart des méthodes.

Cordialement

Docmarti

[Bonero]

@ Casefayere : Merci a pour ta reponse mais apparemment ce n’est pas un probleme de code mais plutot une limitation d’excel comme vient de le preciser Docmarti.
@ Docmarti: je me suis inspire de ton message pour creer le resultat qui suit mais je reste convaincu qu’il avoir une approche beaucoup plus elegante que la mienne.

Je conserve ma function de depart:

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
16
17
18
19
20
21
22
Function fctTMinus(dtStart As Date, n As Byte) As Date
'function qui soustrait/ajoute un certain nombre de jours(n) d'une date de depart(dtStart). _
Si le result tombe sur un weekend alors , la function retourne le vendredi d'avant.
 
    Dim dtTemp As Date
 
    dtTemp = DateAdd("d", -n, dtStart)
 
    'Renvoyer le vendredi d'avant si le result de l'operation donne un weekend.
    Select Case Weekday(dtTemp, vbMonday)
        Case 6
            'Renvoyer le vendredi d'avant si le result tombe sur samedi
            dtTemp = DateAdd("d", -1, dtTemp)
        Case 7
             'Renvoyer le vendredi d'avant si le result tombe sur Dimanche.
             dtTemp = DateAdd("d", -2, dtTemp)
    End Select
 
 
    fctTMinus = Format(dtTemp, "dd/mm/yyyy")
 
End Function

A celle-ci, j’ajoute un bout de code qui verifie si elle(la function fctTMinus) a ete appelee ou non.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Cet evenement verifie si la cellule qui vient d'etre modifiee contient _
la fonction fctTMinus; si OUI alors, le format de la cellule est change en format Date.
 
    Dim FormulaChecker As Byte
    FormulaChecker = InStr(1, Target.Formula, "=fctTMinus", vbTextCompare)
 
    If FormulaChecker <> 0 Then
         Target.NumberFormat = "dd/mm/yyyy"
    Else
    End If
 
End Sub

j'attends vos reactions. Merci d'avance

[Docmarti]

C'est parfait. C'est exactement la façon de faire avec l'événement WorkSheet_Change.

Question élégance : tu peux enlever l'instruction suivante de ta fonction fctTMinus car elle ne sert à rien.

Code :

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

fctTMinus = Format(dtTemp, "dd/mm/yyyy")

Cordialement

Docmarti