Establecer un color de fuente de VBA

Question

Quiero establecer el color de la fuente de una celda a un determinado valor RGB.

Si yo uso

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

Me pongo amarillo, pero si yo uso una más exóticos valor RGB como:

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

Acabo de llegar de un color gris de nuevo.

¿Cómo es que no puedo usar cualquier valor RGB?Y ¿sabe usted las soluciones?

Gracias.

Answer 1

Excel sólo utiliza los colores en la paleta de colores.Cuando se establece una celda con el valor RGB, se selecciona la opción en la paleta, que es la coincidencia más cercana.Usted puede actualizar la paleta con los colores y, a continuación, elija el color y que va a funcionar.

Esto te permitirá ver lo que está actualmente en la paleta:

 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

Esto te permitirá configurar la paleta

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

Un consejo rápido: la paleta de Excel tiene dos filas de colores que rara vez se utilizan y por lo general se pueden ajustar a valores personalizados sin cambios visibles en las hojas de otras personas.

Este es el código para crear un conjunto razonable de colores '' de tonos suaves, que son mucho menos ofensivo que los valores por defecto:

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

Usted puede optar por escribir '' CaptureColors y la función '' para ReinstateColors de cada libro abierto () y BeforeClose () eventos ... O incluso para activar de cada hoja de trabajo y desactivar el evento.

Tengo código de ahí en alguna parte que crea un degradado de color 'térmico' para 3-D gráficos, que le da una progresión de azules a los rojos 'calientes' 'frío' en treinta y dos pasos. Esto es más difícil de lo que parece: un gradiente de colores que se perciben como 'intervalos iguales' por el sistema visual humano (que se ejecuta en una escala logarítmica de la intensidad y tiene ponderaciones no lineales para como los colores rojo, verde y azul 'fuertes' ) necesita tiempo para construir -. y usted tiene que utilizar VBA para coaccionar MS Chart en el uso de los colores seleccionados, en el orden especificado

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

Gracias por las respuestas y los comentarios también.

Realmente me dio un gran problema porque mi cliente había instalado otros complementos en Excel que también manipuló la paleta de colores.

Terminé la sustitución de unos pocos colores en la paleta de un asigning entonces mis elementos de la ColorIndex específica, pero chico, no es bonito.