Convertir RGB en Hex
Bonjour à Tous & Toutes,
Compte-rendu des évènements sur objets ::
J'ai crée 2 usf dynamiquement :
La pemiere sert à récupérer dynamiquement tous les codes utilisés et activer un traitement selon le clic sur le bouton (cela fonctionne très bien)
La seconde est une palette de couleurs permettant de modifier la couleur de la cellule. et insérer le code couleur (cela fonctionne très bien) ; celle-ci est identique à la palette pour les couleur des objets.
Sujet probématique donnant lieu à ce post :
Mais voilà, le code couleur est un nombre il me faudrait la conversion du chiffre en hex car le code sera récupérer pour les boutons soit pour les propriétés BackColor ou BorderColor.
Exemple concret:
ActiveCell.Offset="&" & Right(Hex(RGBC),2) & Left(Right(Hex(RGBC),4),2) _
& Left(Hex(RGBC),2)Résultat obtenu dans ma cellule :
A1 = &FFC080 soit RGBC = (8438015)
Résultat souhaité :
A1=&H0080C0FF
Il manque les 4 derniers digits
Alternative non souhaitée :
Dois-je créer des select case pour chaque RGB obtenu il y en a 49
Recherche en-cours sur le web:
Je ne trouve pas le complément sur la toile
Messieurs, pouvez-vous me conseiller ?
En vous remerciant pour l'attention portée à ma demande.
Cdt
Air_2
Bonjour
Si je ne m'abuse pas
Que tu marques en hexa ou en décimal le résultat est le même
Me.CommandButton1.BackColor = 8438015
Me.CommandButton3.BackColor = &H80C0FFOn obtient la même couleur
Tu peux faire aussi
Me.CommandButton1.BackColor = 8438015
Me.CommandButton3.BackColor = "&H" & Hex(8438015)Bonjour senseï (^_-),
Je vais essayer ta proposition mais avant Grand MERCI, toujours disponible et avec des solutions alternatives.
Hélas :
ActiveCell.Offset="&" & Right(Hex(RGBC),2) & Left(Right(Hex(RGBC),4),2) _
& Left(Hex(RGBC),2)
' OU
ActiveCell.Offset="&" & Hex(RGBC)Il me manque les 4 dernièrs digits mais cela m'evite de taper l'algorithme. ou alors je dois vraiment aller jusqu'au bout de celui-ci.
Je te tiens informé Senseï (^_-)
Air_2
Bonjour
Pourquoi t'emmer t'embêter à transformer le nombre en hexa
La propriété BackColor ou ForeColor accepte les nombres en base 10
Pour BorderColor je ne connais pas avec 2003
PS
Pour info
Obtenir sur 8 caractères ton nombre en Hexa
NombreHexa = Right("00000000" & Hex(8438015), 8)Bonjour Senseï (^_-)
Vraiment je suis un boulet, voila le code :
ActiveCell.Offset = "&H00" & Hex (RGBC)Je dois aller jusqu'au bout afin de m'éviter des surprises je suis sur ce bug depuis 7H00 du matin.
Si le code ne l'accepte pas je devrai recommencer toute mon approche 1 jour HOM dessus.
Grand Merci Senseï
Bon week-end
Air_2
Bonjour
J'avais édité mon message
Réponse plus générique car valable pour les nombres plus petits
Bonsoir,
J'ai ré-ouvert le post car j'ai un petit soucis avec ce coquin de chiffre Hex :
Problème rencontre :
Variable objet ou variable de bloc With non définie "Message=91")
Public Collect As Collection
Public CollectBT As Collection
Public CollectTx As Collection
Private Tx As MSForms.TextBox
Public LigneFin As Variant
Private Sub UserForm_Initialize()
Dim Bouton As MSForms.CommandButton
Dim Fr As MSForms.Frame
Dim Lig As Integer, Col As Integer
Dim Cl As ClasBT
Set Collect = New Collection
Set CollectBT = New Collection
Set CollectTx = New Collection
'----- Initialise l'userform ---------------
With Me
.BackColor = &HC0FFFF
.Height = 900
.Width = 820
.Caption = "Utilitaire d'export Code Rubrique"
End With
'------ Créer la ComboBox1 ------------------
'
' Set ObjComboBox = Me.Controls.Add("Forms.ComboBox.1", "ComboBox1", True)
' With ObjComboBox
' .Name = "Choix2"
' .FontSize = 25
' .Move 100, 6, 500, 30
' .BackColor = &H80FFFF
' End With
'------ Créer la TextBox ------------------
Set Tx = Me.Controls.Add("Forms.TextBox.1", "TextBox1", True)
Set Cl = New ClasBT 'Ajouter à la collection de classe
Set Cl.Texte = Tx
CollectTx.Add Cl
With Tx
.Name = "Rubrique"
.Move 600, 6, 80, 40
.FontSize = 18
.FontBold = True
.TextAlign = fmTextAlignRight
.BackColor = &HC00000
.ForeColor = &HFFFFFF
End With
'------ Créer le Frame1 ---------------------
Set Fr = Me.Controls.Add("Forms.frame.1", "Frame1", True)
Fr.Move 6, 54, 800, 800
Fr.BackColor = &HFFC0FF
Fr.BorderStyle = fmBorderStyleSingle
Fr.BorderColor = &H800080
'------ trier la colonne J ------------------
F1.Rows("10:" & Rows.Count).Select
ActiveWorkbook.Worksheets("Données Importées").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Données Importées").Sort.SortFields.Add Key:=Range _
("J10:J" & Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Données Importées").Sort
.SetRange Range("A10:R" & Rows.Count)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'------ Nombre de textbox selon la colonne J ------------------
Dim LigneFin As Variant
Dim a, b, c, d As Variant
Dim Valeur As Variant
LigneFin = F1.Range("a" & Rows.Count).End(xlUp).Row
For a = 10 To LigneFin
If a = 10 Then
Valeur = F1.Cells(a, 10)
b = 1
Else
If a > 10 And F1.Cells(a, 10) <> Valeur Then
Valeur = F1.Cells(a, 10)
b = b + 1
Else: End If
End If
Next a
'------ Création du tableau ------------------
Dim TB As Variant
ReDim TB(b) 'redimensionne le tableau avant une nouvelle utilisation
For c = 10 To LigneFin
If c = 10 Then
Valeur = F1.Cells(c, 10)
d = 0
TB(d) = CStr(Valeur)
d = d + 1
Else
If c > 10 And F1.Cells(c, 10) <> Valeur Then
Valeur = F1.Cells(c, 10)
TB(d) = CStr(Valeur)
d = d + 1
Else: End If
End If
Next c
'------ Création des boutons ------------------
' selon le tableau ci-dessus --------------------
Dim i As Variant
Dim RGBC As Variant
Dim Val As Variant
Dim L As Variant
c = b / 14
For Lig = 0 To c
i = i
For Col = 0 To 14
Set Bouton = Fr.Controls.Add("Forms.CommandButton.1", "Bt" & i, True)
CollectBT.Add Bouton, CStr(i) 'Ajouter à la collection d'objet
Set Cl = New ClasBT 'Ajouter à la collection de classe
Set Cl.GroupBoutons = Bouton
Collect.Add Cl
'---------------- Je désactive cette partie et cela fonctionne
With F14
Val = TB(i)
L = .Range("A:A").Find(TB(i)).Row
RGBC = .Cells(L, 3).Value
End With
'--------- et donc le BackColor est lui aussi désactivé
With CollectBT(CStr(i)) 'Initialise les boutons
' .BackColor = "&H00" & Hex(RGBC)
.ForeColor = &HFFFFFF
.Tag = i
.Move 10 + (Col * 50), 10 + (Lig * 50), 40, 26
.FontSize = 10
.FontBold = True
If i = b - 1 Then Exit Sub
.Caption = TB(i)
End With
i = i + 1
Next Col
Next Lig
'Erase TB 'libere la mémoire du tableau a voir ou je le positionne
End SubSi tu avais une idée ?
Je vais faire prendre l'air, pour y réfléchir mais je suis bien parti pour un dimanche sur ces lignes sans ton aide.
A très vite,
Air_2
Bonjour
Val est un mot clé réservé ne pas l'utiliser en tant que variable
Je repose ma question
Pourquoi tu passes par la transformation de ton nombre en Hexa ?
.BackColor = RGBCEst valable
Bonsoir,
Je pensais mais mal, que mon problème venait du code couleur alors que non, j'ai respecté ta recommandation.
Elle fonctionne, mon problème est ailleurs...
Il provient de la source ou ce trouve le code couleur. et je n'arrive pas a supprimer l'error et pourtant j'ai changé ma variable :
Val par ValRecupere.
Et la je bloque.
Si tu avais une autre hypothèse, je suis preneur.
A très vite
Air2
Bonsoir
Dans ce cas le fichier avec la macro serait très utile
A suivre
Bonsoir,
J'ai ferme le post car tu m'as apporté la réponse et grand merci.
Cela peut intéresser les visiteurs je savais ou était mon probléme donc j'ai fait ce qui suit :
With F14
Val = TB(i)
L = .Range("A:A").Find(TB(i)).Row
RGBC = .Cells(L, 3).Value
on error goto step1
End With
step1:
Dim erreur as variant
erreur = ValRecupere
'Conclusion le message disait que la recherche avait pour résultat = "" Grand merci encore Senseï (^_-) pour ta patience et tes réponses rapides.
Bonne soirée à toi , tous & toutes
Air_2