Discussion :

[Garruth]

Bonjour à tous,

J'ai un petit problème dans une fonction VBA:

Cette fonction permet de calculer un report de durée dans des cases particulières.

Paramètres d'entrée:
rCellOri: me permet de récupérer la ligne pour mes décalages d'offset
dJoursArr: date de début
rDureeTot: durée totale
sMois, iAnnee: Mois de départ

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
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
Function CALC_REPORT(rCellOri As Range, dJoursArr As Date, rDureeTot As Integer, sMois As String, iAnnee As Integer) As Integer
 
    Dim iMois As Integer
    Dim iJoursRech As Integer
    Dim iTampon As Integer
    Dim i As Integer
 
    'Calcul du mois
 
    Select Case UCase(sMois)
 
        Case "JANVIER": iMois = 1
        Case "FEVRIER": iMois = 2
        Case "MARS": iMois = 3
        Case "AVRIL": iMois = 4
        Case "MAI": iMois = 5
        Case "JUIN": iMois = 6
        Case "JUILLET": iMois = 7
        Case "AOUT": iMois = 8
        Case "SEPTEMBRE": iMois = 9
        Case "OCTOBRE": iMois = 10
        Case "NOVEMBRE": iMois = 11
        Case "DECEMBRE": iMois = 12
 
    End Select
 
    If rDureeTot < (DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr Then 
 
    'si la durée ne dépasse pas le mois pas de report
 
    CALC_REPORT = rDureeTot
 
    Else
 
 
    iTampon = rDureeTot - ((DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr)
 
    'récupération des jours à reporter
 
    i = 1
 
 
    While iTampon > 0
 
        If ((DateSerial(iAnnee, iMois + i + 1, 1) - 1)) - DateSerial(iAnnee, iMois + i, 1) > iTampon Then
        'si la durée ne dépasse pas le nombre de jours du ième mois
            rCellOri.Offset(0, 38 * i).Value = rCellOri.Offset(0, 38 * i).Value + iTampon ' reporter la valeur avec un offset, la fonction s'arrête ici elle ne devrait pas
            iTampon = 0 'fin de la boucle
        Else
            rCellOri.Offset(0, 38 * i).Value = rCellOri.Offset(0, 38 * i).Value + (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1)) 'reporter la valeur avec un offset, la fonction s'arrête ici aussi elle ne devrait pasnon plus
            iTampon = iTampon - (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1)) 'report pour la boucle suivante
            i = i + 1
        End If
 
    Wend
 
    CALC_REPORT = (DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr 'report de la valeur résultante
 
    End If
 
End Function

Le problème est le suivant, dès que je veux modifier une case annexe (les 2 lignes avec un commentaire concernant l'arrêt non désiré) la fonction s’arrête (aucune erreur ne s'affiche, elle s’arrête juste)
Est-ce que le fait de "sortir" une donnée de la fonction à pour effet de la considérer comme finie? Si c'est le cas il y a t il un moyen d’empêcher l'arrêt?

Dans l'espoir d'avoir été clair

Merci d'avance

[EngueEngue]

Pas compris ta question..

Dans excel 2003 nous avons 256 colonnes...

rCellOri.Offset(0, 38 * i) pour i >7 tu vas avoir un beug... puisque tu essayes d'offsetter sur une colonne supérieure à la colonne max...

[Docmarti]

Garruth


La seule façon de sortir d'une fonction c'est qu'il survienne une erreur, ou rencontrer End Function ou Exit Function.

Dans ton cas, ca semble être due à la rencontre d'une erreur. Mets au debut de la fonction la commande On Error Goto ErrorHandler

Et à la fin:

Code :

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

1
2
3
4
5
6
7
 Exit Function
errorhandler:
 MsgBox Error
 Stop
 Resume
 
End Function

Ca devrait te conduire avec la touche F8 à l'endroit du code où se produit l'erreur.


Cordialement

Docmarti

[Garruth]

Merci EngueEngue

Mais concernant le souci de dépassement de capacité, il n'y a pas de problème je suis en 2007 et mon tableau de base dépasse déjà allègrement les 256 colonnes. De plus l'erreur se produit même quand le décalage ne fait qu'une colonne.

Pour donner un exemple je joint un fichier avec l'offset de décalage à 1.

Pour éclaircir un peu les choses, la fonction produit une erreur "transparente", avant que je mette de le petit morceau de code de Docmarty (merci ). L'erreur se produit aux deux lignes de blocages que j'avais notés dans mon premier messages: remplissage d'une valeur a un offset donné à partir de la valeur existante précédemment plus la valeur tampon.

Il m'affiche ça:
"Erreur définie par l'application ou par l'objet"

ça me parait un peu ésotérique comme erreur (disons que ça couvre a peu près tout ^^)

Si quelqu'un à une solution ou une piste de recherche, je prends.

[Docmarti]

Avec le calcul :

Code :

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

 iTampon = iTampon - (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1))

est-ce que la valeur de iTampon augmente ou si elle diminue?
Si elle augmente, tu as un problème.

Quelle est la valeur de iTampon quand l'erreur se produit?

Cordialement

Docmarti

[Garruth]

Bonjour Docmarti

Il y a avait effectivement une erreur à ce niveau, j'ai oublié de remettre le plus (j'ai fait un test avec une valeur fixe d'où le moins)

Code :

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

iTampon = iTampon + (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1))

Dans tout les cas, la ligne impactée se situe après le bug, la fonction n'y arrive jamais.

Ligne du bug:

Code :

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

rCellOri.Offset(0, 1 * i).Value = rCellOri.Offset(0, 1 * i).Value + ((DateSerial(iAnnee, iMois + i + 1, 1) - 1) - DateSerial(iAnnee, iMois + i, 1))

je remet quand même le fichier Exemple corrigé en lien.

Merci

[PMO2017]

Bonjour,

Vous faites une affectation directe d'une valeur dans une cellule et cela n'est pas autorisé.
Voyez le code suivant qui passe par les variables x et y.
Je ne me suis pas étendu à comprendre quel est l'aboutissement de la fonction, aussi adaptez le code pour obtenir le résultat désiré.

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
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
Function CALC_REPORT(rCellOri As Range, dJoursArr As Date, rDureeTot As Integer, sMois As String, iAnnee As Integer) As Integer
 
'    On Error GoTo errorhandler
 
    Dim iMois As Integer
    Dim iJoursRech As Integer
    Dim iTampon As Integer
    Dim i As Integer
    Dim test As Integer
 
    Select Case UCase(sMois)
 
        Case "JANVIER": iMois = 1
        Case "FEVRIER": iMois = 2
        Case "MARS": iMois = 3
        Case "AVRIL": iMois = 4
        Case "MAI": iMois = 5
        Case "JUIN": iMois = 6
        Case "JUILLET": iMois = 7
        Case "AOUT": iMois = 8
        Case "SEPTEMBRE": iMois = 9
        Case "OCTOBRE": iMois = 10
        Case "NOVEMBRE": iMois = 11
        Case "DECEMBRE": iMois = 12
 
    End Select
 
    If rDureeTot < (DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr Then
 
    CALC_REPORT = rDureeTot
 
    Else
 
 
    iTampon = rDureeTot - ((DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr)
    i = 1
 
 
    While iTampon > 0
 
'///
Dim x
If ((DateSerial(iAnnee, iMois + i + 1, 1) - 1)) - DateSerial(iAnnee, iMois + i, 1) > iTampon Then
  x = rCellOri.Offset(0, 1 * i).Value + iTampon
  iTampon = 0
Else
 
Dim y
y = rCellOri.Offset(0, 1 * i).Value + _
((DateSerial(iAnnee, iMois + i + 1, 1) - 1) - DateSerial(iAnnee, iMois + i, 1))
'///
 
iTampon = iTampon + (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1))
            i = i + 1
        End If
 
    Wend
 
'/// [k1] = "toto"   'une affectation directe ne fonctionne pas
 
    CALC_REPORT = (DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr
 
    End If
 
'     Exit Function
'errorhandler:
'        MsgBox Error
'        Stop
'        Resume
 
End Function