Appel d'une fonction au sein d'une autre Résolu

Question

Bonjour tout le monde,
J'ai besoin d'aide svp. J'ai créé une fonction qui me calcule la moyenne des cellules en fonction de leurs couleurs. Je m'exprime, j'ai 3 couleurs différentes:rouge , vert et orange. Pour le rouge j'ai donné la valeur 5, 3 pour l'orange et 1 pour le vert. Ci dessous le code
Public Function moyenneCouleur(plage As Range) As Long

'Declaration des variables
 Dim rouge As Integer
 Dim vert As Integer
 Dim orange As Integer
 Dim cpt As Integer
 Dim tot As Long
 Dim moyenneDeCouleur As Long
 
 'rouge=3 vert=43 orange=45

    Application.Volatile
    For Each c In plage
        cpt = cpt + 1
            If c.Interior.ColorIndex = 3 Then 'rouge
                c = 5
            End If
            If c.Interior.ColorIndex = 43 Then 'vert
                c = 1
            End If
            If c.Interior.ColorIndex = 45 Then 'orange
                c = 2.5
            End If
        tot = tot + c.Value
    Next c
moyenneDeCouleur = tot / cpt
End Function

Maintenant je veux faire appel à cette fonction dans une autre pour jouer sur une le contenu et la couleur d'une autre cellule (U)(en fonction de la moyenne des couleurs récupérée précédemment) mais je n'arrive pas à le faire malheuresement. Voici le code que j'ai fais. Merci bcp de votre aide

Public Function niveauCriticite(plage As Range) As Long

Dim moyenCoul As Range

For Each i In plage

moyenCoul.Value.Call moyenneCouleur(plage)

    If (1 <= moyenCoul <= 3) Then 'Colorer le fond des cellules sélectionnées en vert
        Range("U" & i).Font.ColorIndex = 43
        Range("U" & i).Interior = "Criticité faible"
    End If
    If (3 < moyenCoul <= 4) Then 'Colorer le fond des cellules sélectionnées en orange
         Range("U" & i).Font.ColorIndex = 45
         Range("U" & i).Interior = "Criticité moyenne"
    End If
    If (4 < moyenCoul) Then 'Colorer le fond des cellules sélectionnées en rouge
        Range("U" & i).Font.ColorIndex = 3
        Range("U" & i).Interior = "Criticité haute"
    End If
Next i
End Function

michel_m · Answer

Bonjour

moyenCoul.Value.Call moyenneCouleur(plage) 

j'aurais plutôt écris

moyenCoul=  Call moyenneCouleur(plage)  

mais...
Voir l'aide sur Call
 
 Michel

ecko772 · Answer

Merci Michel pour ta réponse.
J'ai changé la logique et j'ai créé une seule macro. Voici le nouveau code

Public Function niveaucriticite(plage As Range) As Long
'Declaration des variables
 Dim rouge As Integer
 Dim vert As Integer
 Dim orange As Integer
 Dim cpt As Integer
 Dim tt As Long
 Dim moyenneDeCouleur As Long
 Dim Couleur As Double
 
 'rouge=3 vert=43 orange=45

    Application.Volatile
    For Each c In plage
        cpt = cpt + 1
        Couleur = c.Interior.ColorIndex
            If Couleur = 3 Then 'rouge
                c = 5
            Else
                If Couleur = 43 Then 'vert
                    c = 1
                Else
                     If Couleur = 45 Then 'orange
                         c = 3
                     End If
                End If
            End If
        tt = tt + c
    Next c
moyenneDeCouleur = tt / cpt
For Each i In plage

    If (1 <= moyenneDeCouleur <= 3) Then 'Colorer le fond des cellules sélectionnées en vert
        Range("U" & i).Interior.Color = RGB(153, 204, 0) '43
        Range("U" & i).Interior = "Criticité faible"
    Else
        If (3 < moyenneDeCouleur <= 4) Then 'Colorer le fond des cellules sélectionnées en orange
            Range("U" & i).Interior.Color = RGB(255, 153, 0) '45
            Range("U" & i).Interior = "Criticité moyenne"
        Else
            If (4 < moyenneDeCouleur) Then 'Colorer le fond des cellules sélectionnées en rouge
                Range("U" & i).Interior.Color = RGB(255, 0, 0)  '3
                Range("U" & i).Interior = "Criticité haute"
            End If
        End If
    End If
Next i
End Function

Maintenent le souci que j'ai c'est que je n'arrive pas à récupérer le code de la couleur de mes cellules en parcourant la plage, à chaque fois ile me sort le même code -4142 pour toutes les cellules sachant que la couleur change de l'une à l'autre: sur 8 cellules j'ai 3 fois vert, 3 fois rouge et 2 fois orange.

Merci pour ton aide

ecko772 · Answer

Oui effectivement c'est des mises en formes conditionnelles :( parce que pour chaque cellule j'ai plusieurs choix de réponses.
Peux tu stp me dire comment faire ça aussi m'indiquer les fausses déclaration ?
Merci bcp Michel

ecko772 · Answer

:) bn app
Regarde ce que j'ai fais pour récupérer la couleur de la MFC mais le pb c'est que je récupère que le vert alors que la couleur change d'une cellule à l'autre :s
vert-->rouge-->rouge-->orange...

    For Each c In plage
        cpt = cpt + 1
            If c.FormatConditions(1).Interior.ColorIndex = 3 Then 'rouge
                c = 5
            Else
                If c.FormatConditions(1).Interior.ColorIndex = 43 Then 'vert
                    c = 1
                Else
                     If c.FormatConditions(1).Interior.ColorIndex = 45 Then 'orange
                         c = 3
                     End If
                End If
            End If
        tt = tt + c
    Next c

michel_m · Answer

pour essayer de s'en sortir


mettre un extrait de ton  classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/ 
puis copier l'adresse du lien et la coller dans le message de réponse 

mais une fois la moyenne calculée, tu colories bien la plage suivant la moyenne obtenue ?

ecko772 · Answer

Voici le lien généré
https://www.cjoint.com/?0CtoIxgLRjp 
J'ai mis que des lettres comme valeurs mais c'est le même principe.

Pour ta 2em question, j'arrive pas à le faire :s j'ai utilisé ça comme code:

For Each i In plage

    If (1 <= moyenneDeCouleur <= 3) Then 'Colorer le fond des cellules cibles en vert
        Range("L" & i).Interior.Color = RGB(153, 204, 0) '43
        Range("L" & i).Interior = "Criticité faible"
    Else
        If (3 < moyenneDeCouleur <= 4) Then 'Colorer le fond des cellules cibles en orange
            Range("L" & i).Interior.Color = RGB(255, 153, 0) '45
            Range("L" & i).Interior = "Criticité moyenne"
        Else
            If (4 < moyenneDeCouleur) Then 'Colorer le fond des cellules cibles en rouge
                Range("L" & i).Interior.Color = RGB(255, 0, 0)  '3
                Range("L" & i).Interior = "Criticité haute"
            End If
        End If
    End If
Next i

michel_m · Answer

Je veux bien t'aider mais il faudrait que sois cohérent: les couleurs arrivent n'importe comment dans la feuille "évaluation"
un coup la première des plages ans arrive rouge, une autre fois vert, allieurs orange...

donc tu me files un truc correct où je puisse bosser  c'est à dire toujours la m^me couleur suivant le rang dans la plage ans"x"
puis, comme c'est assez complexe, sois patient

je n'ai pas compris pourquoi un classeur au format .xlsm.xls (j'ai 2007)

Donc,j' attend mais...

ecko772 · Answer

En fait j'ai plusieurs ligne dans mon fichier initial mais j'ai laissé d'une seule ligne pour faire le test (ligne n°5)
La plage de test de la colonne D-->K
Le choix des valeurs dans ces cellules (liste déroulante) change leurs couleurs (MFC)
L'objectif est de remplir automatiquement la cellule L de mon fichier par la couleur  et la valeur correspondantes (que L5 dans notre exemple)
Ouvert à toute proposition
Ici le lien vers le fichier avec le bon format
https://www.cjoint.com/?0CtqMxv2paY
mille merci

michel_m · Answer

bon, je n'ai pas lu ton dernier lien(10) car occupé

dans la feuille cricité les valeurs dans validation de données sont dans cet ordre rouge, Orange, Vert renvoi d'une valeur 5,3,1
c'est dans cette ligne

evaluer_couleur = Choose(cptr, 5, 3, 1, 0, 0, 0) 'DONNER VALEUR AUX 3 DERNIERS

à toi de voir pour les validations à 4 et 6 données
s'il n'y a pas de criticitidé, tu peux laisser la cellule vide

Option Explicit'----Function evaluer_critic(Lig) As StringDim Col As ByteDim Total As Integer, Moyenne As IntegerFor Col = 4 To 11     Total = Total + evaluer_couleur(Range("Ans" & Col - 3), Cells(5, Col))NextMoyenne = CInt(Total / 8)Select Case Moyenne     Case Is <= 3          evaluer_critic = "Criticité faible"     Case Is <= 4           evaluer_critic = "Criticité moyenne"     Case Else          evaluer_critic = "Criticité haute"End SelectEnd Function'-----Function evaluer_couleur(Ans_x As Range, indic As Range) As ByteDim Nbre As ByteDim T_ans(), cptr As ByteT_ans() = Application.Transpose(Ans_x)If IsEmpty(indic) Then     evaluer_couleur = 0     Exit FunctionEnd IfFor cptr = 1 To UBound(T_ans)     If indic = T_ans(cptr) Then          evaluer_couleur = Choose(cptr, 5, 3, 1, 0, 0, 0)          Exit For     End IfNextEnd Function

Dans L5 voici ce que l'ai marqué pour prendre en compte la ligne
=evaluer_critic("=ligne()")
 
 Michel

michel_m · Answer

Voilà les codes modifiés
Option Explicit
'----
Function evaluer_critic(Lig) As String
Dim Col As Byte, Cas As Byte
Dim Total As Integer, Moyenne As Integer

'ligne vide
If Application.CountA(Range(Cells(Lig, 4), Cells(Lig, 11))) = 0 Then
     evaluer_critic = ""
     Exit Function
End If

For Col = 4 To 11
     Cas = Col - 3
     Total = Total + evaluer_couleur(Range("Ans" & Cas), Cas, Cells(5, Col))
Next

Moyenne = CInt(Total / 8)
Select Case Moyenne
     Case Is <= 3
          evaluer_critic = "Criticité faible"
     Case Is <= 4
           evaluer_critic = "Criticité moyenne"
     Case Else
          evaluer_critic = "Criticité haute"
End Select
End Function
'-----
Function evaluer_couleur(Ans_x As Range, cas_a As Byte, indic As Range) As Byte
Dim Nbre As Byte
Dim T_ans(), cptr As Byte
Dim Nom As String

T_ans() = Application.Transpose(Ans_x)

If IsEmpty(indic) Then
     evaluer_couleur = 0
     Exit Function
End If

For cptr = 1 To UBound(T_ans)
      
     If indic = T_ans(cptr) Then
          Select Case cas_a
               Case 1
                    '5=rouge, 3=orange, 1=vert, 0=rien ou NA
                    evaluer_couleur = Choose(cptr, 5, 1, 0, 0, 0, 0, 0, 0)
               Case 2
                    evaluer_couleur = Choose(cptr, 5, 0, 1, 0, 0, 0, 0, 0)
               Case 3
                    evaluer_couleur = Choose(cptr, 5, 1, 0, 0, 0, 0, 0, 0)
               Case 4
                    evaluer_couleur = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
               Case 5
                    evaluer_couleur = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
               Case 6
                    evaluer_couleur = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
               Case 7
                    evaluer_couleur = Choose(cptr, 1, 3, 5, 5, 5, 5, 0, 0)
               Case 8
                    evaluer_couleur = Choose(cptr, 1, 3, 5, 0, 0, 0, 0, 0)
          End Select
          Exit For
     End If
Next
End Function

 
evaluer_couleur comporte 8 possibilités pour éventuelle évolution du nombre de variable . A de toi de vérifier si les couleurs sont les bonnes...

appel fonction colonne L
=evaluer_critic(LIGNE())

La maquette:
https://www.cjoint.com/?DCujvMECPsP

ecko772 · Answer

Parfait Michel, C'est exactement ça sauf que quand je fais le test sur les autres lignes ça me prend toujours la valeur de la première ligne :s:s

michel_m · Answer

JE VIENS D'ESSAYER SUR D'AUTRE LIGNES ET CA FONCTIONNE !!! :-((

JE T'ai POURTANT INDIQUER LA SYNTAXE

=evaluer_critic(LIGNE()) 


qu'est que c'est que s:s je n'ai jamais écrit ça dans mon code


Abandon de l'aide

ecko772 · Answer

Dzl Michel je sais que je t'embête mais dans le test If indic = T_ans(cptr) Then, la variable indic ne change pas d'une ligne à autre par ex si c'était "a" dans la cellule D5 et "b" dans D6 elle retourne a. :(
Pour la syntaxe que tu m'a indiquée, j'ai fais la même chose

ecko772 · Answer

C'est bon j'ai trouvé il faut changer "5" par "Lig" dans l'instruction
Total = Total + evaluer_couleur(Range("Ans" & Cas), Cas, Cells(5, Col))

Merci Michel

Appel d'une fonction au sein d'une autre

14 réponses

Discussions similaires

Newsletters