Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Получить заливку ячейки Excel в RGB формате
 
Уважаемые форумчане, можно получить цвет заливки ячейки Excel таким образом:
Код
 Set R = Range("A1")
 x1 = R.Interior.Color 'в цифровом формате, например белый -"16777215"
 x2 = Hex$(x1) 'в шестнадцатеричном выражении - "FFFFFF" 
 x3 = "&H00" & x2 & "&" ' в формате H00+Hex - "&H00FFFFFF&" -используются в пользовательских формах Excel


Как получить в формате RGB (255,255,255), т.е. R=255, G=255, B=255?
Изменено: bedvit - 29 Апр 2015 12:45:13
«Бритва Оккама» или «Принцип Калашникова»?
 
У себя в заметках нашёл такое (файл не качается...):
Код
Если необходимо вычислить RGB, то это делается так:
(фрагмент из файла Уокенбаха, пример здесь: http://www.planetaexcel.ru/docs/forum_upload/post_74452.xls)

Dim HexDigits As String
Dim BluePart As Integer, GreenPart As Integer, RedPart As Integer
UserForm1.SampleLabel.BackColor = ColorButton.BackColor
HexDigits = Hex(ColorButton.BackColor)
Do Until Len(HexDigits) = 6
HexDigits = "0" & HexDigits 'pad with zeros
Loop
BluePart = Val("&h" & Left(HexDigits, 2))
GreenPart = Val("&h" & Mid(HexDigits, 3, 2))
RedPart = Val("&h" & Right(HexDigits, 2))
UserForm1.RGBLabel.Caption = RedPart & " " & GreenPart & " " & BluePart

 
Hugo, использовал Ваши данные, вышло следующее:
Код
...
Set R = Range("A1") 'вводим нужную ячейку
x1 = R.Interior.Color 'в цифровом формате, например белый -"16777215"
x2 = Hex$(x1) 'в шестнадцатеричном выражении - "FFFFFF"
Do Until Len(x2) = 6
x2 = "0" & x2 'догоняем 6 знаков нулями
DoEvents
Loop
x3 = "&H00" & x2 & "&" ' в формате H00+Hex - "&H00FFFFFF&" -используются в пользовательских формах Excel
R = Val("&h" & Right(x2, 2))
G = Val("&h" & Mid(x2, 3, 2))
B = Val("&h" & Left(x2, 2))
'Debug.Print R & " " & G & " " & B  'или MsgBox R & " " & G & " " & B    '-посмотреть... 
...

Спасибо!
Изменено: bedvit - 29 Апр 2015 14:10:22
«Бритва Оккама» или «Принцип Калашникова»?
 
Не понял зачем там такое сложное
Код
Do Until Len(HexDigits) = 6
HexDigits = "0" & HexDigits 'pad with zeros
Loop
когда можно просто
Код
HexDigits = Right("000000" & HexDigits, 6)
 
Hugo, :idea:
«Бритва Оккама» или «Принцип Калашникова»?
 
так R.Interior.Color это запись rgb в виде (r+g*256+ b*256^2)

таким образом:
Код
Function rgb_(Rng)
Dim x, r, g, b
x = Rng.Interior.Color
b = Int(x / 65536)
x = x - b * 65536
g = Int(x / 256)
r = x - g * 256
rgb_ = "(" & r & "," & g & "," & b & ")"
End Function
Sub q()
ActiveCell.Interior.Color = rgb(125,128,200)
MsgBox rgb_(ActiveCell)
End Sub
Изменено: Слэн - 29 Апр 2015 16:07:08
Живи и дай жить..
 
Слэн, отлично!
Hugo, Слэн, коллеги по Excel, кому интересна эта тема ))...
...набросал небольшую форму перевода из одной системы цветов в другую. (см. вложение)
Изменено: bedvit - 29 Апр 2015 18:45:42
«Бритва Оккама» или «Принцип Калашникова»?
Страницы: 1
Читают тему (гостей: 1)