Choix de la couleur de fond de la plage sélectionnée par l'utilisateur
R
Bonjour,
J'aimerai créer une macro qui demande la couleur souhaitée par l'utilisateur et qui l'execute dans la plage de cellules sélectionnées. Voilà le code que j'ai essayé de faire. Il doit me manquer un détail. Il existe peut être aussi une solution plus simple.
Sub couleur()
Dim bleu As String
Dim vert As String
Dim rouge As String
Dim orange As String
Dim jaune As String
Dim gris As String
Dim violet As String
Dim noir As String
Dim blanc As String
Dim rose As String
Dim marron As String
Dim requete As String
bleu = RGB(0, 124, 176)
vert = RGB(0, 181, 41)
rouge = RGB(255, 42, 27)
orange = RGB(218, 110, 0)
jaune = RGB(255, 255, 0)
gris = RGB(122, 123, 122)
violet = RGB(196, 97, 140)
noir = RGB(42, 41, 42)
rose = RGB(216, 160, 166)
marron = RGB(112, 69, 42)
blanc = RGB(255, 255, 255)
requete = InputBox("Couleur souhait?e ?")
Rem Colorer le fond des cellules s?lectionn?es
If requete = "bleu" Or "Bleu" Then
Selection.Interior.Color = bleu
Else
If requete = "vert" Or "Vert" Then
Selection.Interior.Color = vert
Else
If requete = "rouge" Or "Rouge" Then
Selection.Interior.Color = rouge
Else
If requete = "orange" Or "Orange" Then
Selection.Interior.Color = orange
Else
If requete = "Jaune" Or "jaune" Then
Selection.Interior.Color = jaune
Else
If requete = "gris" Or "Gris" Then
Selection.Interior.Color = gris
Else
If requete = "violet" Or "Violet" Then
Selection.Interior.Color = violet
Else
If requete = "noir" Or "Noir" Then
Selection.Interior.Color = noir
Else
If requete = "rose" Or "Rose" Then
Selection.Interior.Color = rose
Else
If requete = "marron" Or "marron" Then
Selection.Interior.Color = violet
Else
MsgBox ("votre couleur n'est pas connue")
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End SubMerci d'avance et bon week-end
Rolo60
Bonjour Rolo,
à tester,
Sub couleur()
Dim bleu As String
Dim vert As String
Dim rouge As String
Dim orange As String
Dim jaune As String
Dim gris As String
Dim violet As String
Dim noir As String
Dim blanc As String
Dim rose As String
Dim marron As String
Dim requete As String
requete = InputBox("Couleur souhait?e ?")
Rem Colorer le fond des cellules s?lectionn?es
With Selection.Interior
Select Case requete
Case "bleu": .Color = RGB(0, 124, 176)
Case "vert": .Color = RGB(0, 181, 41)
Case "rouge": .Color = RGB(255, 42, 27)
Case "orange": .Color = RGB(218, 110, 0)
Case "jaune": .Color = RGB(255, 255, 0)
Case "gris": .Color = RGB(122, 123, 122)
Case "violet": .Color = RGB(196, 97, 140)
Case "noir": .Color = RGB(42, 41, 42)
Case "rose": .Color = RGB(216, 160, 166)
Case "marron": .Color = RGB(112, 69, 42)
Case "blanc": .Color = RGB(255, 255, 255)
Case Else: MsgBox ("votre couleur n'est pas connue")
End Select
End With
End SubR
Bonjour,
Merci tout fonctionne
Merci encore,
Rolo
Bonjour,
On pourrait aussi faire une palette sans avoir à taper le nom de la couleur, en utilisant ColorIndex
R
Bonjour,
Et comment peut-on intégrer cette fonction color index ?
Merdi d'avance
Rolo
Bonjour
Use et abuse de la touche F1...
R
je ne connaissais pas ce raccourci, merci encore
exemples ici : https://forum.excel-pratique.com/viewtopic.php?f=10&t=21547
ou alors
Dim posx As Integer, posy As Integer
Sub CreerPalette()
Dim i As Integer, j As Integer, k As Integer, n As Integer, Sh As Object
Dim r, g, b
r = Array(0, 255, 255, 0, 0, 255, 255, 0, 128, 0, 0, 128, 128, 0, 192, 128, 153, 153, 255, 204, 102, 255, 0, 204, 0, 255, 255, 0, 128, 128, 0, 0, 0, 204, 204, 255, 153, 255, 204, 255, 51, 51, 153, 255, 255, 255, 102, 150, 0, 51, 0, 51, 153, 153, 51, 51)
g = Array(0, 255, 0, 255, 0, 255, 0, 255, 0, 128, 0, 128, 0, 128, 192, 128, 153, 51, 255, 255, 0, 128, 102, 204, 0, 0, 255, 255, 0, 0, 128, 0, 204, 255, 255, 255, 204, 153, 153, 204, 102, 204, 204, 204, 153, 102, 102, 150, 51, 153, 51, 51, 51, 51, 51, 51)
b = Array(0, 255, 0, 0, 255, 0, 255, 255, 0, 0, 128, 0, 128, 128, 192, 128, 255, 102, 204, 255, 102, 128, 204, 255, 128, 255, 0, 255, 128, 0, 128, 255, 255, 255, 204, 153, 255, 204, 255, 153, 255, 204, 0, 0, 0, 0, 153, 150, 102, 102, 0, 0, 0, 102, 153, 51)
position True
taille = 12
supp True
For i = 1 To 8
For j = 1 To 7
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, posx + taille * (i - 1), posy + taille * (j - 1), taille, taille)
.Name = "palette" & i * j
'.TextFrame.Characters.Text = CStr(i * j)
'.TextFrame.Characters.Font.ColorIndex = 1 ' ou 2
.Fill.ForeColor.RGB = RGB(r(i * j - 1), g(i * j - 1), b(i * j - 1))
.OnAction = "'Colorier(" & i * j & ")'"
End With
Next
Next
End Sub
Sub position(ok As Boolean)
On Error GoTo fin
With Selection.Offset(1, 1)
posx = .Left + 2: posy = .Top + 2
End With
Exit Sub
fin:
posx = 400: posy = 100
End Sub
Sub colorier(n As Integer)
Dim p
p = Array(2, 1, 2, 1, 2, 1, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 1, 1, 2, 1, 2, 1, 2, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
Selection.Interior.ColorIndex = n
Selection.Font.ColorIndex = p(n - 1)
supp True
End Sub
Sub supp(ok As Boolean)
For Each Sh In ActiveSheet.Shapes
Sh.Delete
Next
End SubR
Mille mercis !!! Je ne pensais pas que l'on pouvait faire tout ça