Настройка цвета шрифта в VBA

StackOverflow https://stackoverflow.com/questions/377960

Вопрос

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

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

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

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

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

Я просто возвращаю себе серый цвет.

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

Спасибо.

Это было полезно?

Решение

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

Другие советы

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

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




Общедоступный подраздел SetPalePalette (необязательно wbk в формате Excel.Рабочая тетрадь)
' Эта подпрограмма создает пользовательскую палитру светлых тонов, которую вы можете использовать для элементов управления, заголовков и диалоговых окон 
'



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



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



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



Dim bScreenUpdating Как логическое значение



bScreenUpdating = Приложение.Обновление экрана



Если bScreenUpdating = True, то
    Приложение.ScreenUpdating = False
Завершить, если



'Если приложение.Обновление экрана <> bScreenUpdating Затем 
' Приложение.ScreenUpdating = bScreenUpdating
'Завершить, если



Если wbk ничего не значит, тогда
    Установите wbk = ThisWorkbook
Завершите, если



С 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




Закончите С



Если приложение.Обновление экрана <> bScreenUpdating Затем
    Приложение.ScreenUpdating = bScreenUpdating
Завершить, если



Конечная Подлодка



Общедоступный подраздел SetGreyPalette()
' Эта подпрограмма создает пользовательскую палитру оттенков серого, которую вы можете использовать для элементов управления, заголовков и диалоговых окон



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



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



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



Dim bScreenUpdating Как логическое значение



bScreenUpdating = Приложение.Обновление экрана



Если bScreenUpdating = True, то
    Приложение.ScreenUpdating = False
Завершить, если



'Если приложение.Обновление экрана <> bScreenUpdating Затем 
' Приложение.ScreenUpdating = bScreenUpdating
'Завершить, если



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



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



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



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



С помощью этого справочника 
 .Цвета (56) = &H505050
    .Цвета (16) = &H707070
    .Цвета (48) = &H989898
  ' .Цвета (15) = &HC0C0C0
Заканчиваются на



Если приложение.Обновление экрана <> bScreenUpdating Затем
    Приложение.ScreenUpdating = bScreenUpdating
Завершить, если



Конечная Подлодка

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

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

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

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

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

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

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top