Code to convert Bluebeam.CSV to Color-coded rows in excel
Sub ColorRowByColor()
''find
'color' column
LastCol = ActiveSheet.Cells(1, Columns.count).End(xlToLeft).Column
For XCOL = 1 To LastCol
If LCase(ActiveSheet.Cells(1, XCOL).Value) Like "*color*" Then
colorcol = XCOL
Exit For
End If
Next
LastRow = ActiveSheet.Cells(Rows.count,
1).End(xlUp).Row
For irow = 2 To LastRow
ActiveSheet.Rows(irow).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Hex2Dec(ActiveSheet.Cells(irow,
colorcol).Value)
.TintAndShade = 0
.PatternTintAndShade =
0
End With
Next irow
End Sub
Function Hex2Dec(HexVal As String) As Variant
Hex2Dec
= ""
Dim r As Byte
Dim g As Byte
Dim b As Byte
HexVal = Right(HexVal,
6)
''hexinit
= CLng("&H" & HexVal)
'''resturns
half-tone lighter values for backgrounds
r = (CByte("&H" &
Mid(HexVal, 1, 2)) + 255) / 2
If r > 255 Then r = 255
g = (CByte("&H" &
Mid(HexVal, 3, 2)) + 255) / 2
If g > 255 Then r = 255
b = (CByte("&H" &
Mid(HexVal, 5, 2)) + 255) / 2
If b > 255 Then r = 255
On Error Resume Next
Hex2Dec = CLng("&H" &
Hex(r) & Hex(g) & Hex(b))
End Function
Comments
Post a Comment