Formule VBA pour des calculs en fonction de couleur de texte

Bonjour à tous et bonne année 2017 ! et surtout une santé de fer pour affronter les grippes et gastro qui trainent

Je fais appel à vous pour m'aider dans la réalisation d'un outil pour mon activité.

Je cherche à realiser en VBA un module qui ferait la chose suivante.

J'ai un tableau. Sur la seconde feuille j'ai 9 colonnes et dans celles ci je rentre mes depenses. Si ma depense est une depense estimée j'ecris en vert, si elle est realisée je l'ecris en noir. Dans la colonne 10 je voudrais que se fasse la somme de chaque ligne mais uniquement des valeurs verte, dans la 11eme colonne la somme des valeurs en noir.

J'espère m'expliquer correctement

Je vous laisse mon tableau en piece jointe pour que vous puissiez voir plus facilement ce que j'explique. Un petit tableau vaut mieux qu'un grand discours n'est ce pas ?!

Merci à tous

Bonsoir Golcat,

Bonne année également et une santé de fer... pour décoder les explications de nos braves membres!

Voici une macro qui fait le travail, à coller dans le code de la feuille RENCONTRE PRO.

Pour décoder, disais-je car si j'imagine que tes 9 colonnes à calculer sont C:K, les suivantes LNO ont leur formule et M est hors-jeu.

Je ne sais où placer les résultats...

Le code qui suit présente donc 2 lignes mises en commentaire avec des ??? en lieu et place du numéro de colonne de destination.

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Application.Intersect(Target, Range("C11:K34"), Range("C38:K49")) Is Nothing Then
    iRow = Target.Row
    iFlag1 = 0
    iFlag2 = 0
    For x = 3 To 11
        If Cells(iRow, x).Font.Color = RGB(0, 0, 0) Then
            iFlag1 = iFlag1 + Cells(iRow, x)    'nombres noirs
        Else
            iFlag2 = iFlag2 + Cells(iRow, x)    'nombres verts
        End If
    Next
    'cells(iRow,???)=iFlag2  'résultat vert
    'cells(iRow,???)=iFlag1  'résultat noir
End If
'
End Sub

A tester et tu me racontes ce qu'il en est?

A+

Bonsoir,

Function SOMCLRTXTNV(plage As Range, Optional clr As Integer = 0)
    Dim c As Range, cl As Long, tot
    Application.Volatile
    cl = IIf(clr, RGB(0, 176, 80), vbBlack)
    For Each c In plage.Cells
        If c.Font.Color = cl Then
            If IsNumeric(c.Value) Then tot = tot + c.Value
        End If
    Next c
    SOMCLRTXTNV = tot
End Function

Fonction personnalisée. Le 2e argument est optionnel : pour le noir, tu ne mets rien, pour le vert tu mets 1.

(Si on a par la suite à rajouter d'autres couleurs, elle sera facilement réadaptable...)

J'ai également modifié ton incohérente procédure Sheet_SelectionChange !

Incohérente car la commande Application.Volatile est réservée à des procédures Function, et uniquement lorsqu'elles doivent être utilisées en feuilles de calcul.

Ensuite, elle n'était pas cadrée sur la cellule visée B1.

Elle utilisait ActiveSheet au lieu d'utiliser la variable Sh mise à disposition par VBA.

Enfin, utiliser l'évènement Selection au lieu de l'évènement requis Change (il n'y a lieu de changer le nom que s'il est modifié dans la cellule) aboutit à ce qu'elle soit déclenchée sans arrêt dans tout le classeur...) [et elle était visiblement à la source des problèmes que j'ai rencontré, je ne sais pourquoi exactement, mais il a suffi de l'invalider pour que tout rentre dans l'ordre !]

Elle était en outre importée : sa mise en forme n'était pas celle réalisée automatiquement par VBA lorsqu'on insère normalement une telle procédure.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Address = "$B$1" Then Sh.Name = Target.Value
End Sub

Cordialement.

Salut Curulis !

Bonjour MFerrand,

très subtiles ces fonctions en formule!

J'avais trouvé le principe en cherchant une solution 'formule' pour notre hôte sans avoir le temps, ici, de creuser la chose.

@GoldCat,

Histoire quand même d'améliorer mes lignes... pas aussi pro, évidemment!

Une meilleure version en postulant, comme MFerrand, que les résultats s'affichent en NO.

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Application.Intersect(Target, Union(Range("C11:K34"), Range("C38:K49"))) Is Nothing Then
    Application.EnableEvents = False
    iRow = Target.Row
    Range("N" & iRow & ":O" & iRow).ClearContents
    For x = 3 To 11
        iFlag = IIf(Cells(iRow, x).Font.Color = vbBlack, 14, 15)
        Cells(iRow, iFlag) = Cells(iRow, iFlag) + Cells(iRow, x)
    Next
    Application.EnableEvents = True
End If
'
End Sub

A+

Bonjour MFerrand et Curulis

merci pour votre aide

Vous etes de vrai devins, en effet les resultats vont en N pour les sommes en NOIR (Réal) et en O pour les sommes en VERT (prev).

J'ai essayé la seconde proposition, ca marche c'est top ! Mais forcément il y a un petit truc que je voudrais pouvoir modifier.

En effet je rentre mes valeurs en NOIR (si c'est une depense réelle) et en VERT (si c'est une dépense estimée). Or quand je change uniquement la couleur de police d'une cellule la somme en bout de ligne ne change pas. Je suis obligé d'activer la cellule en cliquant dessus puis de valider. J'ai peur d'oublier de faire cette action et que cela me fausse mes resultats.

Que dois je rajouter au module pour que cela fonctionne ?

Sinon pour la formule de Nom de feuille, en effet le ligne Application.volatile est une ligne que j'avais rajouter pour essayer de faire s'actualiser le nom de la feuille. Là aussi quand je rentre la valeur en A1 sur la feuille en B1 une formule fait une rechercheV sur la feuille 1 pour nommer la cellule. Puis la feuille prend le nom de cette cellule. Or si je change manuellement le nom d'une cellule sur la feuille 1 cela change bien sur la feuille la cellule B1 mais ne change pas le nom de l'onglet de la feuille 2.

Si vous avez une idée pour cela aussi je suis preneur

Merci à vous

j'avais zappé que B1 contenait une formule ! Mais dans ce cas, seule cette feuille a besoin de la procédure, il faut donc la supprimer dans ThisWorkbook et mette celle-ci dans le module de la feuille.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then Me.Name = Me.Range("B1")
End Sub

La réaction se fait lors d'un changement en A1...

Quant au problème des fonctions bâties pour prendre en compte les couleurs, il s'agit de mise en forme, et une modification de la mise en forme ne provoque pas de recalcul, ni ne déclenche l'évènement Change.

Le recalcul est provoqué à la saisie de la valeur, donc si on a changé la couleur avant, la mise à jour se fait, si on la change après, elle se fera au prochain recalcul. On peut apuyer sur F9 pour le provoquer...

Le problème est relatif, le recalcul s'opèrera toujours à un moment ou un autre... Si on a un besoin particulier susceptible de survenir immédiatement après une modification, on programme l'évènement correspondant : par exemple on veut imprimer, pour éviter tout risque on programme l'évènement BeforePrint du classeur avec l'instruction Calculate de façon qu'un recalcul soit fait avant impression...

Cordialement.

bonjour à vous

merci pour la formule de calcul, du coup avec F9 je comprends bien le raisonnement

Maintenant le probleme que j'ai c'est de recopier cette formule sur les autres feuilles et zones de mon classeur. C'etait une version allégée que je vous ai fait parvenir.

L'erreur que j'ai c'est une erreur type #VALEUR! je n'arrive pas à comprendre d'où cela vient. Le format de cellule est le meme entre mes deux zones

Je te renvoie à mon premier post ! Tu me fais perdre mon temps là !

Bonsoir Mferrand,

je parle de la formule qui fait les sommes, pas de celle pour le nom de la feuille

Bonne soirée

Citation post d'hier à 1h32 :

[et elle était visiblement à la source des problèmes que j'ai rencontré, je ne sais pourquoi exactement, mais il a suffi de l'invalider pour que tout rentre dans l'ordre !]

Elle, c'est ta SelectionChange ! qui n'a par ailleurs pas lieu d 'être !