Merci mapomme ... je me sens moins seul ;-)La question méritait d'être posée..
peut-être que le 7 est au départ un 8 (lui-même une puissance de 2)+Re,
D'aileurs pourquoi 56 (7 * 2 * 2 *2) ?
Le 2 c'est binaire, on comprend, mais le 7 ? Je ne vois qu'une seule explication : les sept couleurs de l'arc-en-ciel.... Bon je sors...
Donc le gars, il a fait 8 palettes de 8 couleurs (assez logique). Puis subrepticement, il en a subtilisé une pour la garder rien que pour lui en pensant que tout le monde n'y verrait que du feu. C'est raté ! Heureusement pour lui, il y a prescription aujourd'hui.peut-être que le 7 est au départ un 8 (lui-même une puissance de 2)
000000 | FFFFFF | 0000FF | 00FF00 | FF0000 | 00FFFF | FF00FF | FFFF00 |
000080 | 008000 | 800000 | 008080 | 800080 | 808000 | C0C0C0 | 808080 |
FF9999 | 663399 | CCFFFF | FFFFCC | 660066 | 8080FF | CC6600 | FFCCCC |
800000 | FF00FF | 00FFFF | FFFF00 | 800080 | 000080 | 808000 | FF0000 |
FFCC00 | FFFFCC | CCFFCC | 99FFFF | FFCC99 | CC99FF | FF99CC | 99CCFF |
FF6633 | CCCC33 | 00CC99 | 00CCFF | 0099FF | 0066FF | 996666 | 969696 |
663300 | 669933 | 003300 | 003333 | 003399 | 663399 | 993333 | 333333 |
il y a déjà beaucoup de choses écrites là :Je propose qu'on crée un topic dédié pour en discuter
eric
Sub PaletteArcEnCiel()
Dim i As Integer, j As Integer, idx As Integer, k As Integer, R As Integer, G As Integer, B As Integer
ReDim TblR(56)
ReDim TblG(56)
ReDim TblB(56)
ReDim Tblrgb(56)
ThisWorkbook.Sheets.Add
Application.ScreenUpdating = False
[A1] = "Idx": [B1] = "Defaut": [c1] = "Dec": [D1] = "R": [E1] = "G": [F1] = "B": [G1] = "Hex": [H1] = "Arc-en-ciel": [I1] = "Dec": [J1] = "R": [K1] = "G": [L1] = "B": [M1] = "Hex"
For i = 1 To 7
For j = 1 To 8
idx = j + (8 * (i - 1)) ' calcul index de la palette
k = (j - 1) * 32
Select Case i
Case 2
TblR(idx) = 255: TblG(idx) = k: TblB(idx) = 0
Case 3
TblR(idx) = 255 - k: TblG(idx) = 255: TblB(idx) = 0
Case 4
TblR(idx) = 0: TblG(idx) = 255: TblB(idx) = k
Case 5
TblR(idx) = 0: TblG(idx) = 255 - k: TblB(idx) = 255
Case 6
TblR(idx) = k: TblG(idx) = 0: TblB(idx) = 255
Case 1
TblR(idx) = 255: TblG(idx) = 0: TblB(idx) = 255 - k
Case Else '---- de noir 0,0,0 àblanc 255,255,255)
TblR(idx) = Round(((j - 1) * 36.425), 0): TblG(idx) = TblR(idx): TblB(idx) = TblR(idx)
End Select
Tblrgb(idx) = RGB(TblR(idx), TblG(idx), TblB(idx))
With ActiveSheet
.Cells(1 + idx, 1).Value = idx
.Cells(1 + idx, 2).Interior.ColorIndex = idx
R = ThisWorkbook.Colors(idx) Mod 256
G = Int(ThisWorkbook.Colors(idx) / 256 ^ 1) Mod 256
B = Int(ThisWorkbook.Colors(idx) / 256 ^ 2) Mod 256
.Cells(1 + idx, 3).Value = ThisWorkbook.Colors(idx)
.Cells(1 + idx, 4).Value = R
.Cells(1 + idx, 5).Value = G
.Cells(1 + idx, 6).Value = B
.Cells(1 + idx, 7).Value = "&H" & Application.Dec2Hex(B, 2) & Application.Dec2Hex(G, 2) & Application.Dec2Hex(R, 2)
.Cells(1 + idx, 8).Interior.Color = Tblrgb(idx)
.Cells(1 + idx, 9).Value = Tblrgb(idx)
.Cells(1 + idx, 10).Value = TblR(idx)
.Cells(1 + idx, 11).Value = TblG(idx)
.Cells(1 + idx, 12).Value = TblB(idx)
.Cells(1 + idx, 13).Value = "&H" & Application.Dec2Hex(TblB(idx), 2) & Application.Dec2Hex(TblG(idx), 2) & Application.Dec2Hex(TblR(idx), 2)
End With
'********************************************
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!selon le cas activer ou non ces 2 sections'
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! affectation RGB à la palette standard
' ThisWorkbook.Colors(idx) = tblrgb(idx)
'********************************************
Next
Next
'********************************************
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! restoration palette par defaut
' ThisWorkbook.ResetColors
'********************************************
Application.ScreenUpdating = True
End Sub
Sub add_palette_full_color_context()
Dim pop1pop2, bout
With CommandBars("Cell")
.Reset
Set pop1 = .Controls.Add(msoControlPopup, , , 1, True): pop1.Caption = "interior.color"
Set pop2 = .Controls.Add(msoControlPopup, , , 2, True): pop2.Caption = "font.color"
Set bout = pop1.Controls.Add(msoControlButton, , , 1, True)
bout.Caption = "standard": bout.FaceId = 300
bout.OnAction = "'my_color " & """cellinterior""" & "'"
Set bout = pop1.Controls.Add(msoControlButton, , , 2, True)
bout.Caption = "personalisée": bout.FaceId = 1930
bout.OnAction = "'my_color " & Chr(34) & "cellinterior"","" 150 ""'"
Set bout = pop2.Controls.Add(msoControlButton, , , 1, True)
bout.Caption = "standard"
bout.OnAction = "'my_color " & """cellfontcolor""" & "'"
Set bout = pop2.Controls.Add(msoControlButton, , , 2, True)
bout.Caption = "personalisée": bout.FaceId = 1930
bout.OnAction = "'my_color " & Chr(34) & "cellfontcolor"","" 150 ""'"
End With
End Sub
Function my_color(Optional X As Variant = "Getcouleur", Optional perso As String = 0)
Dim x1&, x2&, x3&
If perso > 0 Then x1 = 255: x2 = 10: x3 = 5
If Application.Dialogs(xlDialogEditColor).Show(1, x1, x2, x3) = True Then
Select Case X
Case "cellinterior": ActiveCell.Interior.Color = ActiveWorkbook.Colors(1)
Case "cellfontcolor": ActiveCell.Font.Color = ActiveWorkbook.Colors(1)
Case "Getcouleur": my_color = ActiveWorkbook.Colors(1)
'etc..
'etc..
End Select
End If
End Function
Sub test_out_off_context1() 'personalisée
MsgBox my_color(perso:=1)
End Sub
Sub test_out_off_context2() 'standard
MsgBox my_color
End Sub