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 17277 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
A voir également:

14 réponses

f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
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
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
Le fichier est sur le lien suivant: https://www.cjoint.com/?0CAleHFRoSr
Merci pour ton aide
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
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
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Re,

devrait aller, a vous de confirmer

https://www.cjoint.com/?DCAlMHADA5N
0
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
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
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
Ramone1 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
Merci bcp et bonne journée..
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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