|
|
|
|
duplex13, le lundi 10 décembre 2007 à 17:54:13Configuration: Windows XP Firefox 2.0.0.11 Excel 2000 VBA 6.0
Bonsoir c'est d'un RAL utilisé en peinture dont tu parles ?
tu as combien de lignes de couleur ? il existe bien une palette de couleurs sous Excel mais peut-être pas avec autant de nuances vois à droite dans "ressources autour de ce sujet "... xkristi Tu ne perds jamais ton temps quand tu t'amuses ... |
sinon , tu cliques dans une cellule , format, motifs et dans motifs encore motif une deuxième palette s'ouvre et tu cliques
xkristi Tu ne perds jamais ton temps quand tu t'amuses ... |
Bonjour,
En fait je me suis mal exprimé : je veux automatiquement modifier la couleur d'une cellule en VBA à partir d'une couleur définie en hexadécimal dont la valeur se trouve dans une autre cellule. |
Bonsoir tout le monde,
et un ;-) à xkristi... c'est quoi un RAL au fait ? Essaie si ça correspond à ce que tu veux. Je ne colore pas la cellule (moins de couleurs) mais je dessine un rectangle à la dimension de la cellule à droite de ta selection. Si tu lances plusieurs fois la macro pense à supprimer les objets qui s'empilent. Tu peux sélectionner autant de cellules que tu veux avant de lancer la macro. Le n° de couleur doit être écrit tel que l'as mis (3 octets en hexa). La gestion d'erreur est minimum. Sub couleur()
For Each cel In Selection
Dim x As Single, y As Single, largeur As Single, hauteur As Single
Dim r As Integer, g As Integer, b As Integer
On Error GoTo erreur
x = cel.Offset(0, 1).Left
y = cel.Offset(0, 1).Top
largeur = cel.Offset(0, 1).Width
hauteur = cel.Offset(0, 1).Height
r = CInt("&H" & Left(cel.Value, 2))
g = CInt("&H" & Mid(cel.Value, 3, 2))
b = CInt("&H" & Right(cel.Value, 2))
ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, largeur, hauteur).Fill.ForeColor.RGB = RGB(r, g, b)
erreur:
Next cel
End Sub
eric |
Bonsoir
Je viens de tester le code, transformé pour l'occasion en fonction avec comme paramètre l'adresse de la cellule qui contient la couleur au format hexa et ça marche parfaitement ! Le Code : Public Function setColor1(cel As Range) Dim x As Single, y As Single, largeur As Single, hauteur As Single Dim r As Integer, g As Integer, b As Integer x = cel.Offset(0, 1).Left y = cel.Offset(0, 1).Top largeur = cel.Offset(0, 1).Width hauteur = cel.Offset(0, 1).Height r = CInt("&H" & Left(cel.Value, 2)) g = CInt("&H" & Mid(cel.Value, 3, 2)) b = CInt("&H" & Right(cel.Value, 2)) ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, largeur, hauteur).Fill.ForeColor.RGB = RGB(r, g, b) End Function Merci pour cette astuce ! Bonne Continuation Vincent |
Parfait...
Si au hasard de ton travail tu trouves comment indiquer la couleur directement en hexa poste ici, j'ai cherché et pas trouvé. Merci Bonne soirée eric |
Salut,
Je viens de passer du temps pour trouver la solution (car je n'ai pas rester sur une question sans réponse) et je pense que j'ai trouvé : il n'y a pas de solution. Je m'explique. Voici le code qui pourrait marcher : Public Sub coloreCellule()
Dim lig As Integer
Dim maCouleur As String
For lig = 2 To 15
maCouleur = Range(Cells(lig, 2), Cells(lig, 2)).Value
rouge = Mid(maCouleur, 1, 2)
vert = Mid(maCouleur, 3, 2)
bleu = Mid(maCouleur, 5, 2)
r = CInt("&H" & rouge)
g = CInt("&H" & vert)
b = CInt("&H" & bleu)
Range(Cells(lig, 4), Cells(lig, 4)).Interior.Color = RGB(r, g, b)
Next lig
End Sub
Mais les couleurs de remplissage des cellules doivent être situées dans la palette de excel (56 couleurs je crois). Une ligne de code permet de tester ce que je viens de dire. Il suffit d'exécuter la macro suivante : Public Sub test_couleur_hexa()
maCouleur = &H339966
Range(Cells(16, 1), Cells(16, 4)).Interior.Color = &H339966 ' Vert pale
Range(Cells(17, 1), Cells(17, 4)).Interior.Color = &H808570 ' Pas dans la palette
End Sub
La deuxième ligne de code va colorer les 4 cellules en utilisant la couleur de la palette la plus proche. Je pense que le mieux est donc d'utiliser comme tu l'as fait un objet shape. Pour améliorer le code, il faudrait peut-être en faire une macro qui supprime l'ancien shape avant d'en mettre un nouveau, ce qui ferait une feuille excel toujours propre. Avant de finir, voici une page qui traite de manière exhaustive des couleurs dans excel : http://www.mvps.org/dmcritchie/excel/colors.htm Voilà, je pense que ça doit pourvoir aider certaine personne qui se posait la même question que moi Vincent |
Bonjour,
C'est pour cela que j'avais utilisé un objet et non les cellules, pouvoir afficher toutes les couleurs. Pour ce qui est de supprimer les objets s'il faut tous les contrôler, regarder leur type, leurs position et taille pour les effacer ça risque d'etre un peu lourd pour l'usage... Sinon tu peux ajouter Worksheets("feuil1").DrawingObjects.Delete avec une demande de confirmation pour effacer TOUS les objets de la feuille. eric |
| 05/09 11h46 | Exporter à coup sûr du CSV | Programmation |
| 15/09 10h59 | [Excel] Colorer des cellules sur conditions | Excel |
| 15/09 11h07 | [Excel] Restreindre l'accés aux cellules | Excel |
| 22/08 16h19 | [Excel] Ajouter une date fixe dans une cellule en 2 touches | Excel |
| 12/11 01h11 | [excel] | Excel |
| 23/06 17h17 | Imprimer selon choix de cellule excel | 3 |
| 04/05 12h07 | APPARENCE COULEUR CELLULE EXCEL | 0 |
| 06/07 14h17 | Couleur cellule Excell | 3 |
| 03/07 09h29 | [Excel] Choisir une cellule en fonction de A1 | 11 |
| 17/08 14h26 | Excel couleur cellule selon condition | 8 |
![]() | Excel Viewer - Avec Microsoft Office Excel Viewer 2003, vous pouvez ouvrir, afficher et imprimer des classeurs Excel (fichiers XLS ), même... | Catégorie: Tableur Licence: Freeware/gratuit |
![]() | MOREFUNC (Macro complémentaire EXCEL) - Morefunc est une macro complémentaire proposant 67 nouvelles fonctions de feuille de calcul pour Excel. Ces fonctions sont... | Catégorie: Tableur Licence: Freeware/gratuit |
![]() | la boite a couleurs - La Boîte à Couleurs est une application pour Windows écrite par Benjamin Chartier. Comme son nom l'indique, il offre des... | Catégorie: Couleur Licence: Freeware/gratuit |
![]() | Ms Word Excel Cracker - Ms Word Excel Craker est une application permettant de retrouver les mots de passe perdus ou oubliés pour les fichiers.xls... | Catégorie: Suite bureautique Licence: Freeware/gratuit |
![]() | Sony Micro Vault Excellence | Catégorie: Carte Mémoire / Clé USB | 72.51 € Amazon.fr |
![]() | Sony Micro Vault Excellence | Catégorie: Carte Mémoire / Clé USB | 16.74 € Misco FR |
![]() | Sony Micro Vault Excellence | Catégorie: Carte Mémoire / Clé USB | 23.85 € Amazon.fr |
![]() | Sony Micro Vault Excellence | Catégorie: Carte Mémoire / Clé USB | 38.99 € PriceMinister |