Pb coloration d'une forme en VBA à partir de la couleur d'une cellule.
Bonjour,
Je souhaite que la couleur d'une forme soit identique à la couleur d'une cellule active.
Voici le code pour récupérer la couleur de la cellule Active :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
Function RecupCouleurCase()
Dim CoulRVB As Long
Dim Bleu As Integer
Dim Vert As Integer
Dim Rouge As Integer
CoulRVB = ActiveCell.Interior.color
Rouge = Int(CoulRVB Mod 256)
Vert = Int((CoulRVB Mod 65536) / 256)
Bleu = Int(CoulRVB / 65536)
RecupCouleurCase = "RGB(" & Rouge & ", " & Vert & ", " & Bleu & ")"
End Function |
Voici le code pour colorer la forme :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
Sub CopieValeurCase()
Dim a As String
Dim ColorCase As String
a = RecupCouleurCase
CaseValeur = ActiveCell.Value
ActiveSheet.Shapes.Range(Array("TextBox 6")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = CaseValeur
Selection.ShapeRange.Fill.ForeColor.RGB = a
'Selection.ShapeRange.Fill.ForeColor.RGB = RGB(141, 180, 226)
Range("A1").Select
End Sub |
La valeur récupérée par la variable me semble à première vue correcte, mais j'obtiens une erreur sur la ligne lors de l'exécution du code.
Lorsque j'essaye avec la ligne suivante (actuellement en commentaire) cela fonctionne.
Pouvez-vous m'aider ? Je suis un peu bloqué, Peut-être une poussière dans l'oeil.
Merci
Problème résolu Solution Trouvé
Il semblerait donc que la solution de concaténer ne fonctionne pas pour les couleurs.
Voici donc tout bêtement la solution trouvée :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
Sub CopieValeurCase(Ligne As Integer, Colonne As Integer)
Dim CoulRVB As Long
Dim Bleu As Integer
Dim Vert As Integer
Dim Rouge As Integer
CoulRVB = ActiveCell.Interior.color
Rouge = Int(CoulRVB Mod 256)
Vert = Int((CoulRVB Mod 65536) / 256)
Bleu = Int(CoulRVB / 65536)
CaseValeur = ActiveCell.Value
ActiveSheet.Shapes.Range(Array("TextBox 6")).Select
Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = CaseValeur
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
Cells(Ligne, Colonne).Select
End Sub |
Merci
