Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

noircir une partie de cellule (impossible, non?)

17 réponses
Avatar
Greg
Bonsoir,

Je cherche à faire quelque chose d'un peu particulier, sans savoir si c'est
réalisable... mais ici, vous m'avez habitué à des miracles, alors...

Voilà: Dans une cellule apparait un pourcentage. Auriez-vous une idée pour
que la cellule se noircisse d'autant que la valeur du pourcentage la
contenant?

Merci (même si là, je ne suis pas très opimiste sur la réussite de ce
problème...)

Greg

10 réponses

1 2
Avatar
Tatanka
Salut Greg,

Un essai avant mon premier dodo de la nouvelle année ;-)
Pour le plaisir et en supposant que c'est la cellule D5
qui est concernée :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [D5]) Is Nothing Then
ActiveSheet.Shapes("Masque").Delete
v = [D5]
With Range("D5")
L = .Left
T = .Top
W = .Width
H = .Height
End With
With ActiveSheet.Shapes.AddTextbox _
(msoTextOrientationHorizontal, L, T, v * W, H)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 8
.Name = "Masque"
End With
End If
End Sub

Bonne et heureuse année à tous ceux et celles
qui participent à ce magnifique MPFE !

Serge


"Greg" a écrit dans le message de news:
Bonsoir,

Je cherche à faire quelque chose d'un peu particulier, sans savoir si c'est
réalisable... mais ici, vous m'avez habitué à des miracles, alors...

Voilà: Dans une cellule apparait un pourcentage. Auriez-vous une idée pour
que la cellule se noircisse d'autant que la valeur du pourcentage la
contenant?

Merci (même si là, je ne suis pas très opimiste sur la réussite de ce
problème...)

Greg




Avatar
Carim
Salut Greg,

J'aime beaucoup la solution de Serge ...
Mais si tu cherches à visualiser graphiquement des valeurs :

=REPT("n";A1)

et utiliser, pour cette cellule, le format Wingdings ...

A+
Avatar
Greg
Bonjour et merci pour vos réponses,

En ce qui concerne la formule: =REPT("n";A1),
celle-ci n'est pas adaptée à des pourcentages. De plus, s'il y a un calcul
dans la cellule, comment y insérer 2 formules? Sinon, visuellement, c'est
pas mal.


En ce qui concerne la proposition de Serge, c'est vraiment super, et ça
correspond exactement à cxe que j'attends visuellement. Le problème, c'est
qu'il faut valider la cellule pour que ça fonctionne. Si les calculs sont
faits à l'estérieur de la cellule, ça ne marche pas.

voici la feuille exemple:

http://cjoint.com/?bclXF5pqbb

Lorsque je change les notes, le curseur ne s'adapte pas.

Sinon, c'est exactement mon attente.

Greg
Avatar
Tatanka
Salut Greg,

Alors essaie ceci :
http://cjoint.com/?bcocFJUN5m

Est-ce mieux ainsi ?

Serge


"Greg" a écrit dans le message de news:
Bonjour et merci pour vos réponses,

En ce qui concerne la formule: =REPT("n";A1),
celle-ci n'est pas adaptée à des pourcentages. De plus, s'il y a un calcul
dans la cellule, comment y insérer 2 formules? Sinon, visuellement, c'est
pas mal.


En ce qui concerne la proposition de Serge, c'est vraiment super, et ça
correspond exactement à cxe que j'attends visuellement. Le problème, c'est
qu'il faut valider la cellule pour que ça fonctionne. Si les calculs sont
faits à l'estérieur de la cellule, ça ne marche pas.

voici la feuille exemple:

http://cjoint.com/?bclXF5pqbb

Lorsque je change les notes, le curseur ne s'adapte pas.

Sinon, c'est exactement mon attente.

Greg




Avatar
Tatanka
Et pour éviter que le rectangle cache les gros %,
tu pourrais ajouter .Fill.Transparency = 0.5
dans le code et mettre le % en gras.

Serge


"Tatanka" a écrit dans le message de news: Ofsb4$
Salut Greg,

Alors essaie ceci :
http://cjoint.com/?bcocFJUN5m

Est-ce mieux ainsi ?

Serge


"Greg" a écrit dans le message de news:
Bonjour et merci pour vos réponses,

En ce qui concerne la formule: =REPT("n";A1),
celle-ci n'est pas adaptée à des pourcentages. De plus, s'il y a un calcul
dans la cellule, comment y insérer 2 formules? Sinon, visuellement, c'est
pas mal.


En ce qui concerne la proposition de Serge, c'est vraiment super, et ça
correspond exactement à cxe que j'attends visuellement. Le problème, c'est
qu'il faut valider la cellule pour que ça fonctionne. Si les calculs sont
faits à l'estérieur de la cellule, ça ne marche pas.

voici la feuille exemple:

http://cjoint.com/?bclXF5pqbb

Lorsque je change les notes, le curseur ne s'adapte pas.

Sinon, c'est exactement mon attente.

Greg








Avatar
Carim
Salut Greg,

Le calcul peut être intégré à la formule ...

=REPT("n";(AVERAGE(A5:C5)/20)*20)

A +
Avatar
Tatanka
Une dernière modif :
J'ai changé
For Each r In Target.Rows
pour
For Each r In inters.Rows

Et finalement ça donne :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Set inters = Intersect(Target, [Notes])
If Not inters Is Nothing Then
For Each r In inters.Rows
n = r.Row
nom = CStr(n)
ActiveSheet.Shapes(nom).Delete
v = Cells(n, 4)
With Range("D" & n)
L = .Left
T = .Top
W = .Width
H = .Height
End With
With ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, L, T, v * W, H)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 10
.Fill.Transparency = 0.5
.Name = nom
End With
Next r
End If
End Sub

Serge


















"Tatanka" a écrit dans le message de news:
Et pour éviter que le rectangle cache les gros %,
tu pourrais ajouter .Fill.Transparency = 0.5
dans le code et mettre le % en gras.

Serge


"Tatanka" a écrit dans le message de news: Ofsb4$
Salut Greg,

Alors essaie ceci :
http://cjoint.com/?bcocFJUN5m

Est-ce mieux ainsi ?

Serge


"Greg" a écrit dans le message de news:
Bonjour et merci pour vos réponses,

En ce qui concerne la formule: =REPT("n";A1),
celle-ci n'est pas adaptée à des pourcentages. De plus, s'il y a un calcul
dans la cellule, comment y insérer 2 formules? Sinon, visuellement, c'est
pas mal.


En ce qui concerne la proposition de Serge, c'est vraiment super, et ça
correspond exactement à cxe que j'attends visuellement. Le problème, c'est
qu'il faut valider la cellule pour que ça fonctionne. Si les calculs sont
faits à l'estérieur de la cellule, ça ne marche pas.

voici la feuille exemple:

http://cjoint.com/?bclXF5pqbb

Lorsque je change les notes, le curseur ne s'adapte pas.

Sinon, c'est exactement mon attente.

Greg












Avatar
Greg
Merci à Carim, ça me servira par ailleurs! je garde!!!

Serge, ta proposition est vraiment intéressante, qui plus est, tu as
anticipé le problème visuel des pourcentages! Dernier hic: les bordures
s'effacent. Est-ce possible de les laisser? Où puis travailler ça dans le
code? (Je suppose du cote de "Line visible")

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Set inters = Intersect(Target, [Notes])
If Not inters Is Nothing Then
For Each r In Target.Rows
n = r.Row
nom = CStr(n)
ActiveSheet.Shapes(nom).Delete
v = Cells(n, 4)
With Range("D" & n)
L = .Left
T = .Top
W = .Width
H = .Height
End With
With ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, L, T, v * W, H)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 10 'couleur de la zone de
texte
.Fill.Transparency = 0.5
Name = nom
End With
Next r
End If
End Sub

Merci encore

Greg
"Tatanka" a écrit dans le message de
news:Ofsb4$
Salut Greg,

Alors essaie ceci :
http://cjoint.com/?bcocFJUN5m

Est-ce mieux ainsi ?

Serge


"Greg" a écrit dans le message de news:


Bonjour et merci pour vos réponses,

En ce qui concerne la formule: =REPT("n";A1),
celle-ci n'est pas adaptée à des pourcentages. De plus, s'il y a un
calcul


dans la cellule, comment y insérer 2 formules? Sinon, visuellement,
c'est


pas mal.


En ce qui concerne la proposition de Serge, c'est vraiment super, et ça
correspond exactement à cxe que j'attends visuellement. Le problème,
c'est


qu'il faut valider la cellule pour que ça fonctionne. Si les calculs
sont


faits à l'estérieur de la cellule, ça ne marche pas.

voici la feuille exemple:

http://cjoint.com/?bclXF5pqbb

Lorsque je change les notes, le curseur ne s'adapte pas.

Sinon, c'est exactement mon attente.

Greg








Avatar
Carim
Juste pour l'amusement et le plaisir de combiner les trois infos :
1.la représentation graphique
2.la moyenne des trois notes et
3.le pourcentage ...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRange As Range
Dim Avg1 As Double
Dim Avg2 As Double
Dim Com As String
Dim Rw As Integer

Rw = Target.Row
If Target.Column <> 4 Or IsEmpty(Target.Value) Then Exit Sub
Target.ClearComments
Set myRange = Worksheets("Sheet1").Range(Cells(Rw, 1), Cells(Rw, 3))
Let Avg1 =
FormatNumber(Application.WorksheetFunction.Average(myRange) / 20 * 20,
2)
Let Avg2 = FormatNumber(Application.WorksheetFunction.Average(myRange)
* 5, 2)
Let Com = "Moy:" & Str(Avg1) & vbNewLine & "Pct : " & Str(Avg2) & "%"
Target.AddComment Com
Target.Comment.Visible = False
Target.Comment.Shape.TextFrame.AutoSize = True
End Sub

A +
Avatar
Greg
Ca y est Serge! je n'avais pas vu ta deuxième proposition.

Merci beaucoup pour ton aide...

Greg

"Tatanka" a écrit dans le message de
news:eMl3%
Une dernière modif :
J'ai changé
For Each r In Target.Rows
pour
For Each r In inters.Rows

Et finalement ça donne :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Set inters = Intersect(Target, [Notes])
If Not inters Is Nothing Then
For Each r In inters.Rows
n = r.Row
nom = CStr(n)
ActiveSheet.Shapes(nom).Delete
v = Cells(n, 4)
With Range("D" & n)
L = .Left
T = .Top
W = .Width
H = .Height
End With
With ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, L, T, v * W, H)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 10
.Fill.Transparency = 0.5
.Name = nom
End With
Next r
End If
End Sub

Serge


















"Tatanka" a écrit dans le message de news:


Et pour éviter que le rectangle cache les gros %,
tu pourrais ajouter .Fill.Transparency = 0.5
dans le code et mettre le % en gras.

Serge


"Tatanka" a écrit dans le message de
news: Ofsb4$


Salut Greg,

Alors essaie ceci :
http://cjoint.com/?bcocFJUN5m

Est-ce mieux ainsi ?

Serge


"Greg" a écrit dans le message de news:




Bonjour et merci pour vos réponses,

En ce qui concerne la formule: =REPT("n";A1),
celle-ci n'est pas adaptée à des pourcentages. De plus, s'il y a un
calcul




dans la cellule, comment y insérer 2 formules? Sinon, visuellement,
c'est




pas mal.


En ce qui concerne la proposition de Serge, c'est vraiment super, et
ça




correspond exactement à cxe que j'attends visuellement. Le problème,
c'est




qu'il faut valider la cellule pour que ça fonctionne. Si les calculs
sont




faits à l'estérieur de la cellule, ça ne marche pas.

voici la feuille exemple:

http://cjoint.com/?bclXF5pqbb

Lorsque je change les notes, le curseur ne s'adapte pas.

Sinon, c'est exactement mon attente.

Greg
















1 2