Страницы: 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.04.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.04.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.04.2015 16:07:08
Живи и дай жить..
 
Слэн, отлично!
Hugo, Слэн, коллеги по Excel, кому интересна эта тема ))...
...набросал небольшую форму перевода из одной системы цветов в другую. (см. вложение)
Изменено: bedvit - 29.04.2015 18:45:42
«Бритва Оккама» или «Принцип Калашникова»?
 
Можно и попроще сделать:
Код
Public Sub Test()
Dim Color1 As Variant
Color1 = Range("A1").Interior.Color 'get Color of A1".
R = Color1 Mod 256
G = Color1 \ 256 Mod 256
B = Color1 \ 65536 Mod 256
Debug.Print (R & ";" & G & ";" & B)
Debug.Print (R)
Debug.Print (G)
Debug.Print (B)
End Sub
Изменено: Arthur Alunts - 14.10.2023 12:25:19
 
Еще способ
Код
Private Type tpLong
    l As Long
End Type
Private Type tpRGB
    r As Byte
    g As Byte
    b As Byte
End Type

Sub test()
    Dim lng As tpLong, rgb As tpRGB    
    lng.l = ActiveCell.Interior.Color    
    LSet rgb = lng    
    Debug.Print rgb.r
    Debug.Print rgb.g
    Debug.Print rgb.b
End Sub
Изменено: testuser - 14.10.2023 13:12:54
 
testuser, впечатляет — в 2 раза быстрее варианта на Mod (вариант на Int выбыл по причине некорректности, но там примерно, как на Mod время)
Тест
Большое спасибо! Расскажите, пожалуйста, что там происходит (как раскладывается) и как типы повлияли на скорость?

P.S.: если отойти от теста и избежать преобразований, которые нужны были в тесте для сравнения методов между собой (то есть, напрямую передавать в тип и читать из него), то будет ещё быстрее (возможно, незаметно).
Изменено: Jack Famous - 17.10.2023 11:25:39
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Расскажите, пожалуйста, что там происходит (как раскладывается) и как типы повлияли на скорость?
Сам недавно узнал, про этот трюк с LSet на vb-шном форуме, работает он к сожалению не со всеми типами, только с udt содержащими простые типы данных и со строками. Фактически это копирование одной переменной в другую от левого края. Понять как это работает, можно на примере со строками.
Код
s1 = "111111"
s2 = "222"
LSet s1 = s2 'результат "222111"

LSet очень бытрый метод, я сам его проверял, эквивалентный базовому присвоению по скорости.
Цвет в формате Long это фактически структура из 3 байт (4й не задействован)..
 
testuser, спасибо за пояснения!  :idea:
    Получается, LSet поочерёдно "раскидывает" лонг по байтам?
    Тут говорится, что переносимость не гарантируется из-за особенностей архитектуры. А так мне очень нравится трюк  :)
Изменено: Jack Famous - 17.10.2023 12:25:42
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Получается, LSet поочерёдно "раскидывает" лонг по байтам?
По байтам его раскидывает тип
 
testuser, а LSet копирует. Понял, спасибо.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
 Тут  говорится, что переносимость не гарантируется
На x64 работает также хорошо, с той же скоростью, проверял.
 
testuser, у меня комп и офис как раз 64x (под аватаром инфа)  :idea:

P.S.: вот ещё про LSet (справедливо и для RSet, я полагаю) — там ещё про фиксированные строки написано.
    А вот тут на Кибере — прекрасная демонстрация использования для "выравнивания" данных в строке (например, для вывода сообщения).
    В моей теме подход для решения аналогичной задачи был более банальный (стоит переделать) :D
Изменено: Jack Famous - 17.10.2023 12:40:17
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
фиксированные строки
Фиксированые строки - шняга, лучше их не применять по возможности. У них указатель меняется после каждого чиха, то беж пересоздание. Как это реализовано х.з.. наверное это одна из тех фич, которые реализованй специально плохо в vb*.
 
Цитата
testuser: Фиксированые строки - шняга
как бы да — они, как правило, и медленее обычных строк, однако заполнения строки Mid'ом с участием LSet/RSet могут пригодится (возможно, они быстрее создания буферной строки с помощью Space$() ).
    Пока не тестил, но точно это сделаю  :)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
С LSet решение элегантное, слов нет.
А вот со скоростью не всё так лучезарно. ;)
Скрытый текст
 
Цитата
Апострофф написал:
А вот со скоростью не всё так лучезарно.
Смотря на чем проверять :sceptic:
Код
 0,75 
 0,328125
 
Апострофф, приветствую!
    При всё уважении к вашему опыту, но такой тест не является корректным. У меня всё сведено к функции получений 3ёх чисел из одного. При этом, для варианта от testuser можно ещё ускорить, как я писал выше, если выйти за рамки теста к рабочему инструменту.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Код
Private Sub LongToRGB_Mod(l&, bR As Byte, bG As Byte, bB As Byte)
Dim n&
    bR = (l Mod 256)
    bG = ((l / 256) Mod 256)
    bB = ((l / 65536) Mod 256)
End Sub
Цитата
(l / 256) Mod 256
Обычное деление "/" здесь некорректно, делите нацело - "\".
А AND 255 вместо MOD 256 даст ещё пару копеек к производительности.
 
Апострофф, а вот тут вы совершенно правы. sokol92 вчера ещё мне на это указал в личной переписке, а я деление нацело не заметил… И And 255 тоже чуть поправил. В итоге, вариант на Mod немного быстрее, чем на UserType (и надёжнее) — даёт 0,7 для всех 6ти вариантов на моём тесте
Код
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Остается только вопрос, где-то реально на практике можно ощутить пользу от супербыстрого получения rgb из long? :D
Изменено: testuser - 18.10.2023 13:10:14
 
testuser, пока непонятно, но инструмент напилен  :D
    Навскидку: цвета в лонг-формате Excel кроме как в этом Excel больше нигде интереса не представляют, поэтому для хранения/передачи цветовой информации RGB отлично подходит — нужно будет только 1-255 перевести в 0-100, чтобы хранить насыщенность канала в %. Скорость пригодится при массовой конвертации.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх