Festlegen einer Schriftfarbe in VBA

Question

Ich mag die Schriftfarbe einer Zelle zu einem bestimmten RGB-Wert eingestellt werden.

Wenn ich

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

ich tun bekommen gelb, aber wenn ich eine exotischere RGB-Wert wie:

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

bekomme ich nur eine graue Farbe zurück.

Wie kommt kann ich nicht einfach über die RGB-Wert? Und wissen Sie Abhilfen?

Danke.

Answer 1

Excel verwendet nur die Farben in der Farbpalette. Wenn Sie eine Zelle mit dem RGB-Wert eingestellt ist, wählt er die eine in der Palette, die am nächsten Spiel ist. Sie können die Palette mit Farben aktualisieren und dann Farbe auswählen und in das funktionieren wird.

So können Sie sehen, was derzeit in der 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

Damit können Sie die Palette gesetzt

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

Ein Tipp: die Excel-Palette hat zwei Reihen von Farben, die selten verwendet werden und können in der Regel, um benutzerdefinierte Werte ohne sichtbare Änderungen anderer Völker Blätter eingestellt werden.

Hier ist der Code, um einen vernünftigen Satz von ‚Soft-Ton‘ Farben zu erzeugen, die die Standardwerte weit weniger verletzend als:

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

Sie können für jede Arbeitsmappe Open () und Before () Veranstaltungen ... Oder sogar für jedes Arbeitsblatt des Aktivieren und Deaktivieren Ereignis eines ‚CaptureColors‘ und ‚ReinstateColors‘ Funktion schreiben.

Ich habe Code irgendwo rumliegen, die für 3D-Diagramme einen ‚thermischen‘ Farbverlauf erzeugt, können Ihnen eine Progression von ‚kalten‘ blau ‚Hot‘ Rottöne in zweiunddreißig Schritten geben. Das ist schwieriger, als Sie vielleicht denken: ein Gradient von Farben, die durch das menschliche Sehsystem als ‚gleichen Abständen‘ wahrgenommen wird (die auf einer logarithmischen Skala von Intensität läuft und nicht-lineare Gewichtungen für Rot hat, Grün und Blau als ‚stark‘ Farben ) Zeit zu bauen dauert -. und Sie haben VBA verwenden MS-Diagramm in den Farben zwingen Sie Sie in der angegebenen Reihenfolge angeben,

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

Vielen Dank für die Antworten und die Kommentare auch.

Es hat mir wirklich große Schwierigkeiten, weil mein Mandant hatte andere Plugins in Excel installiert, die auch mit der Farbpalette manipuliert.

Ich landete ein paar Farben in der Palette ersetzt ein dann meine Elemente die spezifische Color zuweist, aber Junge, es ist nicht schön.