Установка цвета шрифта в VBA

Question

Я хочу установить цвет шрифта ячейки для определенного значения RGB.

Если я использую

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

Я получаю желтый, но если я использую более экзотическое значение RGB, например:

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

Я только что получил серый цвет.

Почему я не могу просто использовать какое-либо значение RGB? А знаете ли вы какие-нибудь обходные пути?

Спасибо.

Answer 1

Excel использует только цвета в цветовой палитре. Когда вы устанавливаете ячейку, используя значение RGB, она выбирает ячейку в палитре, которая является наиболее близкой. Вы можете обновить палитру своими цветами, а затем выбрать цвет, и это будет работать.

Это позволит вам увидеть, что в данный момент находится в палитре:

 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

Это позволит вам установить палитру

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

Быстрый совет: палитра Excel имеет две строки цветов, которые используются редко и обычно могут быть установлены на пользовательские значения без видимых изменений на листах других людей.

Вот код для создания разумного набора «мягких» цветов, которые намного менее оскорбительны, чем значения по умолчанию:

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

Конец

Если Application.ScreenUpdating <> bScreenUpdating Application.ScreenUpdating = bScreenUpdating Конец, если

End Sub

Public Sub SetGreyPalette () «Эта подпрограмма создает пользовательскую палитру оттенков серого, которую вы можете использовать для элементов управления, заголовков и диалогов

'** ЭТОТ КОД В ОБЛАСТИ ОБЩЕСТВЕННОСТИ ** Найджел Хеффернан http://Excellerando.Blogspot.com

'Цветовая палитра Excel имеет две скрытые строки, которые используются редко: «Ряд 1: цвета от 17 до 24» - ИСПОЛЬЗУЕТСЯ SetPalePalette в этой книге Ряд 2: цвета от 25 до 32

'Код для захвата существующих настроек Обновления экрана и, при необходимости, временно приостановить обновление, пока эта процедура вызывает раздражение 'мерцает на экране ... не забудьте восстановить обновление экрана при выходе!

Dim bScreen Обновление как логическое

bScreenUpdating = Application.ScreenUpdating

Если bScreenUpdating = True, то Application.ScreenUpdating = False Конец, если

'Если Application.ScreenUpdating <> bScreenUpdating Application.ScreenUpdating = bScreenUpdating 'End If

с ThisWorkbook .Colors (25) = & HF0F0F0 .Colors (26) = & HE8E8E8 .Colors (27) = & HE0E0E0 .Colors (28) = & HD8D8D8 .Colors (29) = & HD0D0D0 .Colors (30) = & HC8C8C8 '& HC0C0C0' Skipped & HC0C0C0 - это обычный 25% серый в основной палитре .Colors (31) = & HB8B8B8 'Обратите внимание, что промежутки становятся шире: человеческий глаз более чувствителен .Colors (32) = & HA8A8A8 'к изменениям в оттенках серого, поэтому это будет восприниматься как линейная шкала Конец

'В правом столбце палитры Excel по умолчанию указаны следующие оттенки серого:

'Цвета (56) = & H333333 'Цвета (16) = & H808080 'Colors (48) = & H969696 'Colors (15) = & HC0C0C0' по умолчанию '25% серый '

'Это следует изменить, чтобы улучшить цветовой разрыв и сделать цвета легко различимыми:

с ThisWorkbook .Colors (56) = & H505050 .Colors (16) = & H707070 .Colors (48) = & H989898 '.Colors (15) = & HC0C0C0 Конец с

Если Application.ScreenUpdating <> bScreenUpdating Application.ScreenUpdating = bScreenUpdating Конец, если

End Sub

Вы можете написать функцию 'CaptureColors' и 'ReinstateColors' для событий Open () и BeforeClose () каждой книги ... Или даже для событий активации и деактивации каждого листа.

У меня где-то есть код, который создает «тепловой» градиент цвета для трехмерных диаграмм, давая вам переход от «холодного» синего к «горячему» красному цвету за тридцать два шага. Это сложнее, чем вы думаете: градиент цветов, который будет восприниматься зрительной системой человека как «равные интервалы» (который работает по логарифмической шкале интенсивности и имеет нелинейные весовые коэффициенты для красного, зеленого и синего как «сильных» цветов). ) требуется время для создания - и вы должны использовать VBA, чтобы заставить MS Chart использовать указанные вами цвета в указанном вами порядке.

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

Спасибо за ответы и комментарии.

Это действительно доставило мне большие неприятности, потому что на моем клиенте были установлены другие плагины в Excel, которые также изменяли цветовую палитру.

В итоге я заменил несколько цветов в палитре, а затем присвоил своим элементам определенный ColorIndex, но, боже, это не красиво.