Résultat macro si changement dans une cellule ne marche pas

Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour tt le monde,
J'ai développé une macro qui calcule la moyenne de la ligne et remplit une cellule (texte+couleur) sur la base de celle moyenne. Avant je faisais appel à ma macro en tappant le nom de la macro avec les paramètres dans la cellule cible. L'objectif maintenant est de faire le même travail mais en passant par le changement de la valeur d'une des cellules. J'ai utilisé Worksheet_Change(ByVal Target As Range), quand ke débugge je réussis à appeler ma macro et je l'éxécute mais pas de résulalt. Quelqu'un peut me dire qu'est ce que j'ai oublié? Voici le code utilisé pour appeler ma macro

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Dim lig As String
Set Rg = Intersect(Target, Range("K:K"))
If Not Rg Is Nothing Then
For Each c In Rg
lig = c.Row
Call evl_crt(lig)
Next
End If
End Sub

14 réponses

  1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    je l'éxécute mais pas de résulalt. Oui, mais pourquoi vous passez le numero de ligne en string a lieu de numerique ?????

    'code simplifie
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("K:K")) Then
    Call evl_crt(Target.Row)
    End If
    End Sub
    0
  2. Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    J'ai passé le numéro de ligne comme numérique et ça marche toujours pas!
    Quand je fais l'appel à la macro avec evl_crt(LIGNE()) dans la cellule concernée ça marche mais en passant par ce code non :(((((
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    avez-vous utilise le code que j'ai ecrit ????

    et comme je n'ai pas le code de evl_crt, peut pas repondre plus
    0
  4. Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Oui je l'ai utilisé. Voici le code de evl_crt, elle fait appel à une autre macro evl_coul qui prend en paramètre le nom de formule que j'ai fait dans une autre feuille de calcul parce que j'ai pour chaque cellule sur lesquelles je calcule la moyenne plusieurs choix de réponses (liste déroulante)

    '----
    Function evl_crt(lig) As String
    Dim Col As Byte, Cas As Byte
    Dim Total As Integer
    Dim Moyenne As Double

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

    For Col = 4 To 11
    Cas = Col - 3
    Total = Total + evl_coul(Range("_Ans" & Cas), Cas, Cells(lig, Col))
    Next

    Moyenne = Total / 8
    Select Case Moyenne
    Case Is < 3
    evl_crt = "risk faible" ' +couleur verte: MFC
    Case Is <= 4
    evl_crt = "risk moyen" '+couleur orange: MFC
    Case Else
    evl_crt = "risk haut" '+couleur rouge: MFC
    End Select
    End Function
    '-----
    Function evl_coul(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
    evl_coul = Choose(cptr, 5, 1, 0, 0, 0, 0, 0, 0)
    Case 2
    evl_coul = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
    Case 3
    evl_coul = Choose(cptr, 5, 1, 0, 0, 0, 0, 0, 0)
    Case 4
    evl_coul = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
    Case 5
    evl_coul = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
    Case 6
    evl_coul = Choose(cptr, 5, 3, 1, 0, 0, 0, 0, 0)
    Case 7
    evl_coul = Choose(cptr, 5, 5, 5, 5, 3, 1, 0, 0)
    Case 8
    evl_coul = Choose(cptr, 5, 5, 3, 1, 0, 0, 0, 0)
    End Select
    Exit For
    End If
    Next
    End Function
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    vu que ce sont des appels de fonction et non de sub routine, cela ne risque pas de marcher.

    Il me faudrait votre fichier modifie si donnees confidentielles, parce que je ne peux pas simuler facilement en partant de rien

    Par hazard, evaluation_criticite ce n'est pas vous ????
    0
  7. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    J'ai recupere le fichier, je vous tiens au courant. Mais vous avez deja fait une demande identique avec comme fichier evaluation_criticite !!!!!!!!
    0
  8. Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Oui mais c'était pour le calcul de la moyenne et j'ai eu la solution grâce à Michel ^^
    Merci encore une fois
    0
  9. Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Parfait, merci pour ton aide et ton temps :)
    Bonne journée
    0
  10. Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Re f894009 ))
    Et si je veux appeler ma fonction via un bouton, comment faire stp?
    (J'ai essayé avec ceci je ne sais pas comment passer le numéro de ma ligne en paramètre((( )


    Sub CommandButton1_Click()

    Call evl_crt (ligne)

    End Sub

    Merci par avance
    0
  11. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    il faut prendre la ligne d'une cellule active de la zone des listes de validation

    exemple:

    Private Sub CommandButton1_Click()
    'test plage
    If ActiveCell.Column >= 4 And ActiveCell.Column <= 8 Then
    Range("L" & ActiveCell.Row) = evl_crt(ActiveCell.Row)
    End If
    End Sub
    0
  12. Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Merci bcp et bonne journée..
    0
  13. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    ai oublie le test ligne

    Private Sub CommandButton1_Click()
    'test plage
    If ActiveCell.Column >= 4 And ActiveCell.Column <= 8 And ActiveCell.Row >= 4 Then
    Range("L" & ActiveCell.Row) = evl_crt(ActiveCell.Row)
    End If
    End Sub
    0