noircir une partie de cellule (impossible, non?)

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Tatanka
Le #5111841
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"
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




Carim
Le #5111791
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+
Greg
Le #5111571
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
Tatanka
Le #5111371
Salut Greg,

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

Est-ce mieux ainsi ?

Serge


"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




Tatanka
Le #5111351
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"
Salut Greg,

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

Est-ce mieux ainsi ?

Serge


"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








Carim
Le #5111301
Salut Greg,

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

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

A +
Tatanka
Le #5111271
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"
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"
Salut Greg,

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

Est-ce mieux ainsi ?

Serge


"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












Greg
Le #5111261
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" news:Ofsb4$
Salut Greg,

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

Est-ce mieux ainsi ?

Serge


"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








Carim
Le #5341081
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 +
Greg
Le #5118101
Ca y est Serge! je n'avais pas vu ta deuxième proposition.

Merci beaucoup pour ton aide...

Greg

"Tatanka" 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"

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" news: Ofsb4$


Salut Greg,

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

Est-ce mieux ainsi ?

Serge


"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
















Publicité
Poster une réponse
Anonyme