L'impostazione di un colore del carattere in VBA

Question

voglio impostare il colore del carattere di una cella per un valore RGB specifico.

Se io uso

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

io capisco giallo, ma se uso un valore più esotico RGB come:

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

Ho appena ottenere un colore grigio indietro.

Come mai non posso semplicemente utilizzare qualsiasi valore RGB? E sapete alcuna soluzione alternativa?

Grazie.

Answer 1

Excel utilizza solo i colori nella tavolozza dei colori. Quando si imposta una cella utilizzando il valore RGB, si sceglie quella della palette che è la corrispondenza più vicina. È possibile aggiornare la tavolozza con i colori e quindi scegliere il vostro colore e che funzionerà.

Questo vi permetterà di vedere ciò che è attualmente nella tavolozza:

 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

Questo vi permetterà di impostare la tavolozza

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 consiglio rapido: Excel tavolozza ha due file di colori che vengono utilizzati raramente e di solito possono essere impostati valori personalizzati senza modifiche visibili fogli di altri popoli.

Ecco il codice per creare un insieme ragionevole di colori 'soft-tone', che sono molto meno offensivo che le impostazioni predefinite:

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

Si può scegliere di scrivere un 'CaptureColors' e la funzione 'ReinstateColors' per l'Open di ogni cartella di lavoro () e BeforeClose () eventi ... O anche per Attiva di ogni foglio di lavoro e disattivare evento.

Ho codice in giro da qualche parte che crea una sfumatura di colore 'termica' per 3-D grafici, dando una progressione da 'freddo' blu per 'Hot' rossi in trentadue gradini. Questo è più difficile di quanto si possa pensare: un gradiente di colori che sarà percepito come 'intervalli uguali' dal sistema visivo umano (che gira su una scala logaritmica di intensità e ha ponderazioni non lineari per i colori rosso, verde e blu 'forti' ) richiede tempo per costruire -. e si deve utilizzare VBA per costringere MS Grafico ad utilizzare i colori specificati, nell'ordine specificato

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

Grazie per le risposte e le osservazioni pure.

E 'veramente mi ha dato grande difficoltà perché il mio cliente aveva altri plugin installati in Excel che manomesso anche con la tavolozza dei colori.

Ho finito per sostituire un paio di colori nella tavolozza di un poi asigning miei elementi dello specifico ColorIndex, ma il ragazzo, non è abbastanza.