XL 2016 calculer cellules en fonction de l'attribut de la police

[Tioneb_h]

Bonjour,

je voudrais voir si il est possible de faire un calcul en fonction de l'attribut de la police ?
voir exemple

merci d'avance,
Benoît

 

[Deadpool_CC]

Bonjour,
dans les formules ... pas de fonction dispo sur les mises en page d'une cellule (couleur police, ...)
tu va devoir passer par du VBA.

 

[Tioneb_h]

Bonjour,
dans les formules ... pas de fonction dispo sur les mises en page d'une cellule (couleur police, ...)
tu va devoir passer par du VBA.

Bonjour, je ne sais pas créer de VBA… vous pouvez me le faire ?
Benoît

 

[Calvus]

Bonsoir,

Voici un fichier, à adapter en fonction de tes besoins réels.

Code en Feuil1

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim i As Integer
    If Not Intersect(Range("F:F"), Target) Is Nothing And Target.Count = 1 Then
        For i = 1 To Range("F" & Rows.Count).End(xlUp).Row
            If Cells(i, 6) <> "" And Cells(i, 6).Font.Strikethrough = True Then
                Cells(i, 8).FormulaLocal = "=D" & i
            ElseIf Cells(i, 6) <> "" And Cells(i, 6).Font.Strikethrough = False Then
                Cells(i, 8).FormulaLocal = "=D" & i & "+ F" & i
            End If
        Next i
    End If
Exit Sub
End Sub

A+

 

[job75]

Bonjour Tioneb_h, Deadpool_CC, Calvus,

Les modifications des attributs de police ne créent pas d'évènements en VBA.

Pour y remédier on peut faire tourner une macro en arrière-plan, voyez le fichier joint.

Le code du ThisWorkbook :

Private Sub workbook_Open()
Application.OnTime 1, "Calcul" 'lance la macro
End Sub

Le code de Module1 :

Function Barré(c As Range)
Application.Volatile
Barré = IIf(c.Font.Strikethrough, 0, c)
End Function

Sub Calcul() 'tourne en arrière-plan
Dim t#
Do
    [H:H].Calculate
    t = Timer + 0.1
    While Timer < t And t < 86400: DoEvents: Wend 'attente de 0.1 seconde
Loop
End Sub

Pour arrêter la boucle dans VBA menu Exécution => Réinitialiser.

A+

 

[job75]

Le code précédent ne permet pas le copier-coller, pour y remédier remplacer :

[H:H].Calculate

par :

If Not ThisWorkbook.Saved Then [H:H].Calculate: ThisWorkbook.Saved = True

 

[soan]

Bonjour Benoît, Deadpool, Calvus, job75,

* pour toute ta colonne E avec les signes « + » : j'ai mis un format Texte ➯ ça devient inutile de saisir d'abord une apostrophe devant : tape directement le caractère « + ».

* pour toute ta colonne G avec les signes « = » : j'ai mis un format Texte ➯ ça devient inutile de saisir d'abord une apostrophe devant : tape directement le caractère « = ».
​

---

* la cellule active est B8 ; or pour une ligne donnée (ici 8), peu importe la colonne où tu es (B ou autre) : ça fera pareil en ligne 8, pour ce qui suit : fais Ctrl b, et regarde les changements en F8 et H8 ; si c'est ok, fais ensuite de nouveau Ctrl b, et regarde à nouveau les changements en F8 et H8 ; c'est toujours ok ?

* va sur la ligne 9, par exemple en C9 ; amuse-toi avec Ctrl b, comme tu as fait ci-dessus ; sauf que cette fois, tu dois évidemment regarder les changements en F9 et H9.

* si tu essayes les mêmes manips sur la ligne 10, ça ne fera rien du tout ! c'est normal, car la cellule F10 est vide : y'a aucun nombre ➯ le montant de H10 est inchangé.

* si tu essayes les mêmes manips sur la ligne 11, ça ne fera rien du tout ! c'est normal, car la cellule F11 contient 0,00 € : nombre nul ➯ le montant de H11 est inchangé.
​

* bien sûr, ça ne fait rien non plus sur une ligne entièrement vide ! car en colonne F, la cellule est vide !

fin de la démo ; j'espère que tu auras aimé ! ​

---

code VBA de Module1 (17 lignes) :

Option Explicit

Sub Barré()
  Dim flg As Boolean, cp&, vx@
  With Cells(ActiveCell.Row, 6)
    vx = Val(.Value): .NumberFormat = "#,##0.00 $"
    If vx > 0 Then
      With .Font
        cp = 10066329 - .Color: .Color = cp
        flg = Not .Strikethrough: .Strikethrough = flg
        If flg Then vx = 0
      End With
      .Offset(, 2) = .Offset(, -2) + vx
    End If
  End With
End Sub

soan

 

[soan]

Bonjour Tioneb_h,

j'ai vu que tu es passé hier :

mais il semble que tu oublies tes sujets !

tu n'as pas téléchargé le fichier de mon post #7,
et tu n'as pas donné de réponse !

soan

 

[Tioneb_h]

Bonjour Tioneb_h,

j'ai vu que tu es passé hier :

Regarde la pièce jointe 1143136

mais il semble que tu oublies tes sujets !

tu n'as pas téléchargé le fichier de mon post #7,
et tu n'as pas donné de réponse !

soan

bonjour,

j'ai vu le mail... mais je n'ai pu donner suite.
je regarde maintenant

benoît

 

[Tioneb_h]

bonjour,

j'ai vu le mail... mais je n'ai pu donner suite.
je regarde maintenant

benoît

salut,
super... ça fonctionne
par-contre, je voix que la formule disparait ?

merci pour ton retour,
benoît

 

[Tioneb_h]

Le code précédent ne permet pas le copier-coller, pour y remédier remplacer :

[H:H].Calculate

par :

If Not ThisWorkbook.Saved Then [H:H].Calculate: ThisWorkbook.Saved = True

salut,
super... ça fonctionne
je vais partir sur ton modèle.
merci,
benoît

 

[soan]

Bonjour Benoît,

citation tirée de ton post #10 :

super... ça fonctionne
par-contre, je vois que la formule disparait ?

dans le fichier joint de ton post #1, il n'y a pas de formule ! j'ai téléchargé le nouveau fichier de ton post #10 ; je le regarderai plus tard, quand j'aurai plus de temps ; même si tu es déjà satisfait de la proposition de job75, j'essayerai de trouver moi-même une solution pour ton nouveau fichier ; si je vais trouver quelque chose de valable, je le posterai.​

pour ton autre sujet, je t'ai répondu avec mon post #7.

soan

 

[Tioneb_h]

Bonjour Benoît,

citation tirée de ton post #10 :

dans le fichier joint de ton post #1, il n'y a pas de formule ! j'ai téléchargé le nouveau fichier de ton post #10 ; je le regarderai plus tard, quand j'aurai plus de temps ; même si tu es déjà satisfait de la proposition de job75, j'essayerai de trouver moi-même une solution pour ton nouveau fichier ; si je vais trouver quelque chose de valable, je le posterai.​

pour ton autre sujet, je t'ai répondu avec mon post #7.

soan

ok