?

Log in

iCamel
Разрозненные обрывки
Малая механизация 
11th-Nov-2016 03:04 pm
БА

Прислали табличку с кучей цветов. Напутали там. Чтобы самому не запутаться, написал макрос. Макрос в выделенном диапазоне берет код цвета из каждой ячейки и красит этим цветом фон в ячейке. Вот только обработки ошибок нет. Если в ячейке нет совсем ничего похожего на цвет, покрасит в черный.



Sub ShowHexRGBColor()
'
' Applies the hex colour code in cell to cell background
' no validity check
'

    For Each acell In Selection.Cells
        
        If Left(acell.Text, 1) = "#" Then startPos = 2 Else startPos = 1
        
        red = WorksheetFunction.Hex2Dec(Mid(acell.Text, startPos, 2))
        green = WorksheetFunction.Hex2Dec(Mid(acell.Text, startPos + 2, 2))
        blue = WorksheetFunction.Hex2Dec(Mid(acell.Text, startPos + 4, 2))
        
        
        With acell.Interior
            .pattern = xlSolid
            .Color = RGB(red, green, blue)
        End With
        
        With acell.Font
          If 0.299 * red + 0.587 * green + 0.114 * blue <= 127 Then
             .Color = vbWhite
          Else
             .Color = vbBlack
          End If
        End With
    Next acell
End Sub
This page was loaded Feb 27th 2017, 8:43 pm GMT.