convertir les codes couleur RVB, Hexa, Dec etc

[Bricofire]

Bonjour,

Hier soir j'avais un soucis de conversion pour faire ton sur ton entre des objets VBA et un soft d'image, j'ai donc cherché et je vous communique le résultat car c'est trop cool pour qui en a besoin..

-1 Un truc gratuit, très bien fait : Palette 2.0 ici :

Ce lien n'existe plus

bon, il ne fait pas direct les codes hexa Office, en prenant le code Hexadécimal (cliquer sur le bouton >>>>) , en remplaçant le80 du départ par H00 et en rajoutant des & à chaque extrémité, c'est oK pour la palette de base propriétés VBA. On peut aussi intervenir en RGB direct avec une ligne de code, mais ce n'est pas le sujet...

-2 La nouvelle Barre VMN Toolbox fait la même chose et bien plus (beaucoup, beaucoup), gratuite pour le moment, mais en contrepartie, elle pond ses cookies et spyware...(normal, on accepte ou non le contrat).

Sinon, il y a aussi Fast Color Codes qui fait les conversions directes en hexa Office et quelques autres, mais il est payant (10 à 15 €)...

Bonne journée à tous,

Brico


PS : Honni soit qui mal y pense, si un truc du genre existe déjà ici, ben plutôt que de me vilipender, réfléchissons au moyen de rendre plus accessible les mines de trésors que recèle XLD

 

[MichelXld]

Re : convertir les codes couleur RVB, Hexa, Dec etc

bonjour cher Bricofire

ce lien pourra peut etre t'interesser




bon apres midi
MichelXld

 

[Bricofire]

Re : convertir les codes couleur RVB, Hexa, Dec etc

Arf Michel

c'est tout à fait ça, c'est exactement ce qu'il me fallait LoL, heureusement que j'avais mis un postscriptum, le plus fort c'est qu'hier soir j'ai parcouru la recherche et j' ai du passer sur un fil qui comportait le lien, mais le contenu n'a pas du me paraître explicite, une fois chargé, plus de question, la case récupérer automatiquement la couleur répond exactement au besoin
Bref c'est bien fait étonnant ? LoL²
Sinon, il est vrai qu'il serait bon de créer un index de trésors performant et clair surtout, par contre est-ce dans le sens de la philosophie d'XLD vu que tout bien mis en ordre, il n'y aurait plus guère de questions auxquelles répondre et qu'à chercher on découvre plein de choses indirectement...

merci et bonne journée,

Brico

 

[zorglubxp]

Bonjour,

Je deterre un peu ce topic, mais le lien cité par MichelXld ne semble plus être indexé sur ce forum.
J'ai opéré une recherche avec les mots clés du lien, et ça ne renvoi aucun résultats.

Donc si quelqu'un trouve comment traduire un code couleur excel (ActiveCell.Interior.Color) ou code couleur RGB en code couleur excel hexadécimal (ceux utilisés dans les userform (ex : &#80FF000010&), ça m’intéresse

 

[Staple1600]

Bonsoir à tous

Il y a une palanquée de discussions qui traite du sujet sur le forum
En voici une prise au hasard
https://www.excel-downloads.com/threads/palette-56-couleurs-dans-excel-2007.233112/#post-1489612

Sinon regarde ceci que je viens de ressortir de mes archives

Function getRGB1(rcell) As String
    Dim sColor As String

    sColor = Right("000000" & Hex(rcell.Interior.Color), 6)
    getRGB1 = Right(sColor, 2) & Mid(sColor, 3, 2) & Left(sColor, 2)
End Function
'source: Allen Wyatt

 

[zorglubxp]

Merci Staple1600

Mais du coup, comment appeler ta fonction pour en avoir le résultat par exemple sur l'activecell ?
Désolé, mais je ne suis pas très fortiche en VBA, et encore moins lorsqu'il s'agit des fonctions que je n'utilise encore que très peu

 

[Staple1600]

Re

Voici une macro pour tester la fonction

Sub Test()
MsgBox CouleursRGB(ActiveCell)
End Sub

 

[Modeste geedee]

Bonsour®

Donc si quelqu'un trouve comment traduire un code couleur excel (ActiveCell.Interior.Color) ou code couleur RGB en code couleur excel hexadécimal (ceux utilisés dans les userform (ex : &#80FF000010&), ça m’intéresse

A partir des composantes RGB de la cellule
Rouge=Application.DECHEX(ActiveCell.Interior.Color MOD 256 , 2)
Vert=Application.DECHEX(INT(ActiveCell.Interior.Color/256) MOD 256 , 2)
Bleu=Application.DECHEX(INT(ActiveCell.Interior.Color/256^2) MOD 256 , 2)
RGBHEX="&h" & "00" & Bleu & Vert & Rouge

 

[zorglubxp]

Re

Voici une macro pour tester la fonction

Sub Test()
MsgBox CouleursRGB(ActiveCell)
End Sub

Ok, donc si je traduis ça doit donner :

Sub Test()
        MsgBox getRGB1(ActiveCell)
End Sub

Telle que tu me l'avais écrit j'avais une erreur, et comme cela ça fonctionne bien.
Cependant, le code hexa est plus court que celui qui est associé aux controls comme notamment les commandbutton.backcolor que je souhaite modifier

 

[Staple1600]

Bonsoir Modeste

Toujours issu de mes archives
Mais à côté de ton fichier, y a pas photo
D'ailleurs, je cherchais le(s) fil(s) où tu vais déjà poster ce fichier mais pas réussi à le trouver.

Sub Couleurs_XL()
Dim i&, str0$, str$
  With Cells(1, 1).Resize(, 7)
  .Value = Array("FOND", "POLICE", "HTML", "ROUGE", "VERT", "BLEU", "COULEUR")
  .Font.Bold = True
  End With
For i = 0 To 56
  Cells(i + 2, 1).Interior.ColorIndex = i: Cells(i + 2, 2).Font.ColorIndex = i: Cells(i + 2, 2) = "[Couleur:" & i & "]"
  str0 = Right("000000" & Hex(Cells(i + 2, 1).Interior.Color), 6)
  str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
  Cells(i + 2, 3) = "#" & str
  Cells(i + 2, 4) = "=Hex2dec(""" & Right(str0, 2) & """)"
  Cells(i + 2, 5) = "=Hex2dec(""" & Mid(str0, 3, 2) & """)"
  Cells(i + 2, 6) = "=Hex2dec(""" & Left(str0, 2) & """)"
  Cells(i + 2, 7) = "[Couleur:" & i & "]"
Next i
  With [A1].CurrentRegion
  .Borders.LineStyle = 1: .HorizontalAlignment = xlCenter
  End With
End Sub
'adapté de colors56 - databison

 

[Staple1600]

Re

@>zorglubxp
J'ai fait une erreur de copier/coller
Mais tu as su la rectifier
Désolé

 

[zorglubxp]

Wahou, merci les gars

Je tire la langue car ça pique un peu (pour ne pas dire beaucoup)
Je n'arrive pas trop à exploiter vos fichiers ou code pour le moment, mais je gratte

J'essaye avec le 1er code de staple (le 2nd me fait peur)

 

[Staple1600]

Re

J'essaye avec le 1er code de staple (le 2nd me fait peur)

Tu parles de mon second code ou du classeur posté par Modeste geedee?

Tu peux lancer la macro Couleurs_XL sans souci, en l’exécutant sur une feuille vierge.

 

[zorglubxp]

Ok, donc pour l'instant avec la fonction de staple + une sub que j'ai trouvé en fouinant, ça me donne ça :

Public Function getRGB1(rcell) As String
    Dim sColor As String

    sColor = Right("000000" & Hex(rcell.Interior.Color), 6)
    getRGB1 = Right(sColor, 2) & Mid(sColor, 3, 2) & Left(sColor, 2)
End Function


Sub a_test() 'raccourcis ctrl+m
'Convertir les codes couleurs en valeurs RGB

    Dim RGBC, Blue, Green, Red As Long
   
    RGBC = ActiveCell.Interior.Color
   
    Red = Int(RGBC Mod 256)
    Green = Int((RGBC Mod 65536) / 256)
    Blue = Int(RGBC / 65536)
   
    MsgBox "Hexa : " & getRGB1(ActiveCell) & Chr(10) & Chr(10) & _
    "Excel Color :" & RGBC & Chr(10) & Chr(10) & _
    "RED (rouge): " & Red & vbCr & vbCr & _
    "GREEN (vert): " & Green & vbCr & vbCr & _
    "BLUE (bleu): " & Blue, , " RGB Values"

End Sub

Ma MsgBox fonctionne bien , il me reste plus qu'à transformer le code hexa court en code hexa long

 

[zorglubxp]

Re



Tu parles de mon second code ou du classeur posté par Modeste geedee?

Tu peux lancer la macro Couleurs_XL sans souci, en l’exécutant sur une feuille vierge.

Non je parlais bien de ton 2nd code

lorsque je disais qu'il me faisait peur c'est que je ne comprends pas quel est le but de cette procédure.
n'etant pas experimenté en vba, sans commentaire dans le code j'ai souvant du mal à comprendre où on veut en venir sauf lorsque je reconnais certaines inscriptions. Mais il y en a tellement à assimilé, et comme pour le travail d'une langue étrangère, je ne pratique que trop peu souvent et perd donc rapidement le benefice de mes séances !


Edit :
C'est bien ce que je pensais, ne sachant pas ce que faisait ton code, je n'aurais pas du l'executer. ça ma chibré la page sur laquelle j'étais et comme un con je n'avais pas sauvegarder avant d'executer. (C'est de ma faute !!!)
Pas très grave, je vais revenir sur une version precedente de mon fichier, je n'avais pas fait trop de changements depuis (il faut juste que je les retrouve car j'ai fait des petis essais partout )