Définition d'une couleur de police dans VBA

Question

Je veux définir la couleur de la police d'une cellule à une valeur RVB spécifique.

Si j'utilise

ActiveCell.Color = RGB(255,255,0)

Je reçois jaune, mais si j'utilise une valeur RVB plus exotiques comme:

ActiveCell.Color = RGB(178, 150, 109)

Je viens d'obtenir une couleur grise arrière.

Comment se fait je ne peux pas utiliser juste une valeur RGB? Et savez-vous des solutions de contournement?

Merci.

Answer 1

Excel utilise uniquement les couleurs dans la palette de couleurs. Lorsque vous définissez une cellule en utilisant la valeur RVB, il choisit celui de la palette qui est la plus proche. Vous pouvez mettre à jour la palette avec vos couleurs, puis choisissez votre couleur et qui fonctionne.

Cela vous permettra de voir ce qui est actuellement dans la palette:

 Public Sub checkPalette()
      Dim i As Integer, iRed As Integer, iGreen As Integer, iBlue As Integer
      Dim lcolor As Long
      For i = 1 To 56
        lcolor = ActiveWorkbook.Colors(i)
        iRed = lcolor Mod &H100  'get red component
        lcolor = lcolor \ &H100  'divide
        iGreen = lcolor Mod &H100 'get green component
        lcolor = lcolor \ &H100  'divide
        iBlue = lcolor Mod &H100 'get blue component
        Debug.Print "Palette " & i & ": R=" & iRed & " B=" & iBlue & " G=" & iGreen
      Next i
    End Sub

Cela vous permettra de définir la palette

Public Sub setPalette(palIdx As Integer, r As Integer, g As Integer, b As Integer)
  ActiveWorkbook.Colors(palIdx) = RGB(r, g, b)
End Sub

Answer 2

Une astuce rapide: la palette Excel a deux lignes de couleurs qui sont rarement utilisées et peuvent généralement être réglés sur des valeurs personnalisées sans modifications visibles sur les feuilles des autres peuples.

Voici le code pour créer un ensemble raisonnable de couleurs « tons doux » qui sont beaucoup moins offensive que les paramètres par défaut:

Public Sub SetPalePalette(Optional wbk As Excel.Workbook)
' This subroutine creates a custom palette of pale tones which you can use for controls, headings and dialogues
'

' **      THIS CODE IS IN THE PUBLIC DOMAIN   **
' Nigel Heffernan   http://Excellerando.Blogspot.com

' The Excel color palette has two hidden rows which are rarely used:
' Row 1: colors 17 to 24
' Row 2: colors 25 to 32   - USED BY SetGrayPalette in this workbook
'

' Code to capture existing Screen Updating settting and, if necessary,
' temporarily suspend updating while this procedure generates irritating
' flickers onscreen... and restore screen updating on exit if required.

Dim bScreenUpdating As Boolean

bScreenUpdating = Application.ScreenUpdating

If bScreenUpdating = True Then
    Application.ScreenUpdating = False
End If

'If Application.ScreenUpdating <> bScreenUpdating Then
'    Application.ScreenUpdating = bScreenUpdating
'End If

If wbk Is Nothing Then
    Set wbk = ThisWorkbook
End If

With wbk

.Colors(17) = &HFFFFD0  ' pale cyan
.Colors(18) = &HD8FFD8  ' pale green.
.Colors(19) = &HD0FFFF  ' pale yellow
.Colors(20) = &HC8E8FF  ' pale orange
.Colors(21) = &HDBDBFF  ' pale pink
.Colors(22) = &HFFE0FF  ' pale magenta
.Colors(23) = &HFFE8E8  ' lavender
.Colors(24) = &HFFF0F0  ' paler lavender


End With

If Application.ScreenUpdating <> bScreenUpdating Then
    Application.ScreenUpdating = bScreenUpdating
End If

End Sub

Public Sub SetGreyPalette()
' This subroutine creates a custom palette of greyshades which you can use for controls, headings and dialogues

' **      THIS CODE IS IN THE PUBLIC DOMAIN   **
' Nigel Heffernan   http://Excellerando.Blogspot.com

' The Excel color palette has two hidden rows which are rarely used:
' Row 1: colors 17 to 24 ' - USED BY SetPalePalette in this workbook
' Row 2: colors 25 to 32

' Code to capture existing Screen Updating settting and, if necessary,
' temporarily suspend updating while this procedure generates irritating
' flickers onscreen... remember to restore screen updating on exit!

Dim bScreenUpdating As Boolean

bScreenUpdating = Application.ScreenUpdating

If bScreenUpdating = True Then
    Application.ScreenUpdating = False
End If

'If Application.ScreenUpdating <> bScreenUpdating Then
'    Application.ScreenUpdating = bScreenUpdating
'End If

With ThisWorkbook
    .Colors(25) = &HF0F0F0
    .Colors(26) = &HE8E8E8
    .Colors(27) = &HE0E0E0
    .Colors(28) = &HD8D8D8
    .Colors(29) = &HD0D0D0
    .Colors(30) = &HC8C8C8
    '             &HC0C0C0 ' Skipped &HC0C0C0 - this is the regular 25% grey in the main palette
    .Colors(31) = &HB8B8B8 ' Note that the gaps are getting wider: the human eye is more sensitive
    .Colors(32) = &HA8A8A8 ' to changes in light greys, so this will be perceived as a linear scale
End With

'The right-hand column of the Excel default palette specifies the following greys:

'   Colors(56) = &H333333
'   Colors(16) = &H808080
'   Colors(48) = &H969696
'   Colors(15) = &HC0C0C0   ' the default '25% grey'

' This should be modified to improve the color 'gap' and make the colours easily-distinguishable:

With ThisWorkbook
    .Colors(56) = &H505050
    .Colors(16) = &H707070
    .Colors(48) = &H989898
  ' .Colors(15) = &HC0C0C0
End With

If Application.ScreenUpdating <> bScreenUpdating Then
    Application.ScreenUpdating = bScreenUpdating
End If

End Sub

Vous pouvez choisir d'écrire un « CaptureColors » et la fonction 'ReinstateColors pour les événements de (Open) et BeforeClose () de chaque classeur ... Ou même pour l'activation de chaque feuille de calcul et de désactiver l'événement.

J'ai le code qui traîne quelque part qui crée un dégradé de couleurs « thermique » pour les graphiques 3-D, vous donnant une progression du bleu au rouge « Hot » « froid » dans trente-deux étapes. Cela est plus difficile que vous pourriez penser: un dégradé de couleurs qui seront considérés comme des « intervalles égaux » par le système visuel humain (qui fonctionne sur une échelle logarithmique d'intensité et a des pondérations non linéaires pour que les couleurs « forts » rouge, vert et bleu ) prend du temps pour construire -. et vous devez utiliser VBA pour exercer des pressions sur MS Chart en utilisant les couleurs que vous spécifiez, dans l'ordre que vous avez spécifié

Answer 3

Sub color()

bj = CStr(Hex(ActiveCell.Interior.Color))
If Len(bj) < 6 Then
    Do Until Len(bj) = 6
        bj = "0" & bj
    Loop
End If

R = CLng("&H" & Right(bj, 2))
bj = Left(bj, Len(bj) - 2)
G = CLng("&H" & Right(bj, 2))
bj = Left(bj, Len(bj) - 2)
B = CLng("&H" & bj)

End Sub

Answer 4

Merci pour les réponses et les commentaires aussi bien.

Il m'a vraiment donné beaucoup de mal parce que mon client avait d'autres plug-ins installés dans Excel qui a également trafiqué la palette de couleurs.

J'ai fini par remplacer quelques couleurs dans la palette d'un asigning alors mes éléments de la ColorIndex spécifique, mais le garçon, ce n'est pas assez.