Boucle impromptue

[Bourakrak]

Bonjour le forum,

J'essaie de faire une fonction avec VBA me permettant de calculer une fraction d'un chiffre en fonction de critères.
J'explique : j'ai un chiffre dans une cellule et sur la même ligne j'ai une suite de cellules colorées vertes, oranges ou rouges. L'idée est de récupérer à la sortie une fraction du chiffre de départ en fonction de la couleur dans chaque cellule qui suit.

J'ai donc créer des variables public pour enregistrer les ratio nécessaires.

Public Const ratio1 As String = "0.005;0.01;0.05"
Public Const ratio2 As String = "0.005;0.01;0.05"
Public Const ratio3 As String = "0.005;0.01;0.05"

Ensuite j'ai une fonction qui transforme la couleur d'une cellule en chiffre.

Function ColorToNumber(ByVal target As Range) As Integer
    
    Select Case target.Interior.ColorIndex
        Case 3
            ColorToNumber = 1
        Case 45
            ColorToNumber = 2
        Case 4
            ColorToNumber = 3
    End Select
    
End Function

Et enfin, j'ai la fonction qui me donne le résultat final.

Function Calcul() As Double
    
    Dim lig As Integer
    lig = Application.Caller.Rows
    Dim Ws As Worksheet
    Set Ws = Application.Caller.Parent
    
    Dim nb(0 to 2) As Integer
    Dim ratio(0 to 2) As Double

    'MsgBox "test"
    nb(0) = ColorToNumber(Ws.Cells(lig, 4))
    'MsgBox "test2"
    nb(1) = ColorToNumber(Ws.Cells(lig, 5))
    nb(2) = ColorToNumber(Ws.Cells(lig, 6))
    ratio(0) = Split(ratio1, ";")(nb(0))
    'MsgBox ratio(0)
    ratio(1) = CDbl(Split(ratio2, ";")(nb(1)))
    ratio(2) = CDbl(Split(ratio3, ";")(nb(2)))
    
    Calcul = Ws.Cells(lig, 3).Value * (ratio(0) + ratio(1) + ratio(2))
    
End Function

Mon problème est le suivant : la fonction ColorToNumber fonctionne, mais lors de l'éxecution de la fonction Calcul, je n'ai ni le MsgBox "test2", ni le MsgBox ratio(0) qui se lance (non commentés bien sûr), de plus le MsgBox "test" se lance 4 fois.
Je n'ai pourtant aucune boucle, et je ne teste ma fonction que dans une cellule pour l'instant.
Evidemment, la fonction renvoie 0 à la fin de son éxecution.

Quelqu'un saurait-il où se situe le problème ? J'avoue ne pas être très à l'aise avec les tableaux (j'ai appris ça hier), mais je n'ai pas l'impression d'avoir fait une quelconque erreur.

Merci de votre aide.

 

[Modeste geedee]

Re : Boucle impromptue

Bonsour®
une fonction renvoie une valeur !!!
un message, un evenement sera ignoré

si tu veux mettre au point ta fonction
renomme la temporairement en Sub

affiche ta variable finale par:
Msgbox Ws.Cells(lig, 3).Value * (ratio(0) + ratio(1) + ratio(2))

lance alors la sub via Alt-F8

lorsque cela sera au point
renomme ta sub en Function
remplace msgbox final par Calcul =
supprimme les autres msgbox et points d'arret éventuels

 

[camarchepas]

Re : Boucle impromptue

Bonjour,

Comment est lancée la fonction Calcul ?

Si c'est un événementiel , il faut mettre un drapeau tant que l'ensemble de la fonction n'est pas terminée afin d'interdire à nouveau l'appel de la fonction Calcul

 

[Dranreb]

Re : Boucle impromptue

Bonjour.
Référence circulaire.
Application.Caller : Le range appelant la fonction.
Application.Caller.Rows : Ses lignes. Bon, il n'y en a qu'une donc ça ne change rien, c'est toujours cette seule cellule.
Lig = Application.Caller.Rows : .Value est assumé derrière, ce qui provoque sa propre évaluation préalable.

P.S. Application.Caller.Row, sans "s" à la fin aurait affecté le n°de ligne de la cellule à lig.

À +

 

[Bourakrak]

Re : Boucle impromptue

Rebonjour, et merci pour vos réponses à tous les deux.

J'ai apporté quelques modifications pour en faire une macro.
Maintenant j'ai une erreur 13 : Incompatibilité de type sur la ligne

ratio(0) = Split(ratio1,";")(nb(0))

De même pour

ratio(0) = CDbl(Split(ratio1,";")(nb(0)))

 

[Bourakrak]

Re : Boucle impromptue

Sinon ce n'est pas grave,

C'est les tableaux qui font sauter le tout. Je vais donc m'en passer. Je vais perdre en souplesse dans le code, mais au moins ça marchera.

Merci quand même de votre aide !

 

[Bourakrak]

Re : Boucle impromptue

Désolé du triple post, mais j'ai résolu le problème en gardant les tableaux.

Pour le problème de boucle, et comme l'a suggéré Dranreb, il suffit d'utiliser Application.Caller.row, sans le s donc.
Ensuite, j'ai résolu mon incompatibilité de Type en utilisant la fonction Val au lieu de CDbl.

Merci à tous.

Bonne journée.