Formule ou macro
Résolu
vcloclo1
Messages postés
501
Date d'inscription
Statut
Membre
Dernière intervention
-
vcloclo1 Messages postés 501 Date d'inscription Statut Membre Dernière intervention -
vcloclo1 Messages postés 501 Date d'inscription Statut Membre Dernière intervention -
Salut,
Voici un exemple pour mon problème.
Voila, j'ai dans un fichier excel créer un cercle "Ellipse" et j'ai créer une liste déroulante avec :
CHOIX 1
CHOIX 2
Je voudrai si c'est possible faire en sorte que lorsque je choisi dans la liste CHOIX 1 que le cercle devienne bleu et si c'est CHOIX 2 qu'il devienne rouge
Comment faire ?
Merci
Voici un exemple pour mon problème.
Voila, j'ai dans un fichier excel créer un cercle "Ellipse" et j'ai créer une liste déroulante avec :
CHOIX 1
CHOIX 2
Je voudrai si c'est possible faire en sorte que lorsque je choisi dans la liste CHOIX 1 que le cercle devienne bleu et si c'est CHOIX 2 qu'il devienne rouge
Comment faire ?
Merci
A voir également:
- Formule ou macro
- Formule si ou - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Formule moyenne excel plusieurs colonnes - Guide
- Formule mathématique - Télécharger - Études & Formations
- Formule somme excel colonne - Guide
15 réponses
Bonsoir,
Voici une proposition :
http://www.cijoint.fr/cjlink.php?file=cj201003/cijU2D1k1n.xls
N'hésite pas si tu as des questions.
Voici une proposition :
http://www.cijoint.fr/cjlink.php?file=cj201003/cijU2D1k1n.xls
N'hésite pas si tu as des questions.
Salut,
@ Gord21
Ton code marche mais moi je veux que le fond change de couleur, pas seulement le contour.
@ Mike-31
J'ai une erreur de débogage
Merci
@ Gord21
Ton code marche mais moi je veux que le fond change de couleur, pas seulement le contour.
@ Mike-31
J'ai une erreur de débogage
Merci
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Re,
Bizarre, je viens de le retester sans problème
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
Bizarre, je viens de le retester sans problème
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
Re,
Salut Gord21,
Si le code à été recopié ou un rond redessiné il est possible que la shape ne corresponde plus à oval 1 ou ellipse 1 dans ce cas adapter le code ou renommer la shape
Salut Gord21,
Si le code à été recopié ou un rond redessiné il est possible que la shape ne corresponde plus à oval 1 ou ellipse 1 dans ce cas adapter le code ou renommer la shape
Re,
Il serait possible de faire une boucle, mais je pense dans ton cas rester simple et doubler le code en gras.
Soit l'autre forme est piloté par la même liste déroulante et on prend référence sur la cellule A2 soit on modifie le code.
De même pour les formes, soit on reprend le nom de création Ellipse1 etc ..., soit on renomme chaque forme et on entre le nom à la place d' Oval 1 et 4 dans le code
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Shapes("Oval 1").Select
If [A2] = "Choix1" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 15
Selection.ShapeRange.Fill.Visible = msoTrue
ElseIf [A2] = "Choix2" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Else
Selection.ShapeRange.Fill.Visible = msoFalse
End If
ActiveSheet.Shapes("Oval 4").Select
If [A2] = "Choix1" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 3
Selection.ShapeRange.Fill.Visible = msoTrue
ElseIf [A2] = "Choix2" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 6
Selection.ShapeRange.Fill.Visible = msoTrue
Else
Selection.ShapeRange.Fill.Visible = msoFalse
End If
[A2].Select
End Sub
Il serait possible de faire une boucle, mais je pense dans ton cas rester simple et doubler le code en gras.
Soit l'autre forme est piloté par la même liste déroulante et on prend référence sur la cellule A2 soit on modifie le code.
De même pour les formes, soit on reprend le nom de création Ellipse1 etc ..., soit on renomme chaque forme et on entre le nom à la place d' Oval 1 et 4 dans le code
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Shapes("Oval 1").Select
If [A2] = "Choix1" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 15
Selection.ShapeRange.Fill.Visible = msoTrue
ElseIf [A2] = "Choix2" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Else
Selection.ShapeRange.Fill.Visible = msoFalse
End If
ActiveSheet.Shapes("Oval 4").Select
If [A2] = "Choix1" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 3
Selection.ShapeRange.Fill.Visible = msoTrue
ElseIf [A2] = "Choix2" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 6
Selection.ShapeRange.Fill.Visible = msoTrue
Else
Selection.ShapeRange.Fill.Visible = msoFalse
End If
[A2].Select
End Sub
Moi j'ai utilisé se code :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'
' Déclaration des variables
Dim couleur As Integer
Dim option_selectionnee As String
'
' Initialisation des variables
option_selectionnee = Range("A4").Value
'
' Changement de couleur du cercle
Select Case option_selectionnee
Case "Type"
couleur = 1 '1 = blanc
Case "Echappement"
couleur = 0 '0 = noir
Case "Admission"
couleur = 30 '30 = bleu
'Couleur par default
Case Else
couleur = 1
End Select
'
With ActiveSheet.Shapes("Oval 1")
.Fill.Visible = msoTrue
.Fill.Solid
'Couleur de fond
.Fill.ForeColor.SchemeColor = couleur
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
'Couleur de cercle
.Line.ForeColor.SchemeColor = 0
End With
'
'
End Sub
L'esprit c'est comme un parachute, qui est utile seulement quand il est ouvert.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'
' Déclaration des variables
Dim couleur As Integer
Dim option_selectionnee As String
'
' Initialisation des variables
option_selectionnee = Range("A4").Value
'
' Changement de couleur du cercle
Select Case option_selectionnee
Case "Type"
couleur = 1 '1 = blanc
Case "Echappement"
couleur = 0 '0 = noir
Case "Admission"
couleur = 30 '30 = bleu
'Couleur par default
Case Else
couleur = 1
End Select
'
With ActiveSheet.Shapes("Oval 1")
.Fill.Visible = msoTrue
.Fill.Solid
'Couleur de fond
.Fill.ForeColor.SchemeColor = couleur
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
'Couleur de cercle
.Line.ForeColor.SchemeColor = 0
End With
'
'
End Sub
L'esprit c'est comme un parachute, qui est utile seulement quand il est ouvert.
Oui. Le code que j'ai mis est adapter marche nikel sur "Oval 1" reste plus qu'a faire pour "Oval 2".
Merci
Merci
Pour le deuxième ovale, tu déclares deux nouvelles variables (par exemple couleur_2 et option_selectionnee_2) puis tu copies tout le code compris entre l'initialisation des variables et la fin du End With. Tu colles le texte copié avant le End Sub et tu remplaces dans le texte copié couleur par couleur_2, option_selectionnee par option_selectionnee_2, Oval 1 par Oval 2. Penses à adapter la cellule source (A4).
Ok, tous fonctionne comme je le désiré.
Par contre, j'ai créer un bouton "Remise à zero" que dois je mettre comme macro pour que sa me mette par defaut le choix "Type" dans la case "A4" puis par exemple les cases A10,B10,C10 (c'est un exemple)
Merci
Par contre, j'ai créer un bouton "Remise à zero" que dois je mettre comme macro pour que sa me mette par defaut le choix "Type" dans la case "A4" puis par exemple les cases A10,B10,C10 (c'est un exemple)
Merci
Ok, tous marche nikel.
Vu que j'y suis, et sa peu servir pour plus tard, ou peu t'ont trouver les correspondance de toutes les couleurs en macro ?
Genre "0" pour le noir, "1" pour le blanc, etc...
Merci
Vu que j'y suis, et sa peu servir pour plus tard, ou peu t'ont trouver les correspondance de toutes les couleurs en macro ?
Genre "0" pour le noir, "1" pour le blanc, etc...
Merci
Merci ;-)
Par contre, moi le 30 sa correspond avec celui de ton fichier.
Par contre, moi le 30 sa correspond avec celui de ton fichier.
Bonsoir,
Tu dois copier le code proposé par UsulArrakis dans ton classeur et lancer la macro. La palette est liées à ton classeur, certaines couleurs de ton classeur peuvent correspondre à celui de UsulArrakis mais ce n'est pas systématique. Tu peux adapter ta palette à ton besoin à l'aide de la fonction RGB en macro ou manuellement.
Tu dois copier le code proposé par UsulArrakis dans ton classeur et lancer la macro. La palette est liées à ton classeur, certaines couleurs de ton classeur peuvent correspondre à celui de UsulArrakis mais ce n'est pas systématique. Tu peux adapter ta palette à ton besoin à l'aide de la fonction RGB en macro ou manuellement.
Je me suis mal expliquer, se que je voulais dire, c'est que moi dans ma macro, le 30 me donne une couleur bleu alors que sur se tableau sa donne un rouge foncé.
Bonjour,
Oui les codes couleurs ne sont pas les mêmes en fonction des objets. Pour les formes, utilise plutôt ce code :
Oui les codes couleurs ne sont pas les mêmes en fonction des objets. Pour les formes, utilise plutôt ce code :
Sub PaletteCouleur2() Dim Couleur As Long Dim rectangle As Shape Application.ScreenUpdating = False Cells(1, 3).Value = "Couleur" Cells(1, 4).Value = "Code Couleur" For Couleur = 1 To 56 Set rectangle = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Cells(1 + Couleur, 3).Left, Cells(1 + Couleur, 3).Top, Cells(1 + Couleur, 3).Width, Cells(1 + Couleur, 3).Height) rectangle.Fill.ForeColor.SchemeColor = Couleur rectangle.Line.Visible = msoFalse Cells(1 + Couleur, 4).Value = Couleur Next Application.ScreenUpdating = True End Sub