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

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

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

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

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

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

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

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

спасибо.

6
colors excel excel-vba rgb vba

4 ответов

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
7

Быстрый совет: палитра 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




Заканчивается



Если Приложения.ScreenUpdating  bScreenUpdating затем
    Приложение.Свойство screenupdating = bScreenUpdating
Конец Если



End Sub



Публичный Суб SetGreyPalette()
"Эта подпрограмма создает пользовательскую палитру greyshades, которую вы можете использовать для управления, заголовков и диалогов



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



 ' цветовая палитра Excel имеет две скрытые строки, которые редко используются:
'Row 1: colors 17 to 24' - используется SetPalePalette в этой книге
' Строка 2: цвета от 25 до 32



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



Dim bScreenUpdating как Boolean



bScreenUpdating = приложение.Свойство screenupdating



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



'Если Приложение.ScreenUpdating  bScreenUpdating затем
- Заявление.Свойство screenupdating = bScreenUpdating
- Конец, Если!--2-->


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



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



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



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



С ThisWorkbook
    .Цвета(56) = & H505050
    .Цвета(16) = &H707070
    .Цвета (48) = &H989898
  '.Цвета (15) = & HC0C0C0
Конец С



Если Приложения.ScreenUpdating  bScreenUpdating затем
    Приложение.Свойство screenupdating = bScreenUpdating
Конец, Если



End Sub

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

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

2
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
1

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

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

Я закончил тем, что заменил несколько цветов в палитре, а затем asigning мои элементы конкретного ColorIndex, но мальчик, это не красиво.

0