UserForm1
Option Explicit
Private Const ColumnCount As Long = 10
Private Const RowCount As Long = 6
Private Const LabelWidth As Single = 18
Private Const LabelHeight As Single = 18
Private Const LabelBuffer As Single = 3
Private Sub cboColourPalettes_Change()
AssignColours cboColourPalettes.Value
End Sub
Private Sub UserForm_Initialize()
AddControls
With cboColourPalettes
.AddItem "MSO_2016"
.AddItem "MSO_2013"
.ListIndex = 0
End With
End Sub
Private Sub cmdColours_Click()
AssignColours "MSO_2016"
End Sub
Private Sub AddControls()
Dim c As Long
Dim r As Long
Dim i As Long
Dim lbl As MSForms.Label
Dim TopPos As Single
Dim LeftPos As Single
TopPos = 10
LeftPos = 10
For c = 1 To ColumnCount
TopPos = 10
For r = 1 To RowCount
i = i + 1
Set lbl = Me.Controls.Add("Forms.Label.1", "Label_" & i, True)
With lbl
.Caption = vbNullString
.Width = LabelWidth
.Height = LabelHeight
.Left = LeftPos
.Top = TopPos + IIf(r > 1, 8, 0)
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(221, 221, 221)
.BackStyle = fmBackStyleOpaque
End With
TopPos = TopPos + LabelHeight + LabelBuffer
Next r
LeftPos = LeftPos + LabelWidth + LabelBuffer
Next c
End Sub
Private Sub AssignColours(ByVal ColourPalette As String)
Dim c As Long
Dim r As Long
Dim i As Long
Dim lbl As MSForms.Label
Dim Target As Range
Set Target = colours.Range(ColourPalette)
For c = 1 To ColumnCount
For r = 1 To RowCount
i = i + 1
Set lbl = Me.Controls("Label_" & i)
lbl.BackColor = Target.Cells(i, 1).Interior.Color
Next r
Next c
End Sub
mdlMain
Option Explicit
Sub Show_Palette()
Dim frm As UserForm1
Set frm = New UserForm1
frm.Show vbModeless
End Sub
Sub AssignColoursFromRGB()
Dim Target As Range
Dim cell As Range
Set Target = Range("C2:C61")
Dim a() As String
For Each cell In Target.Cells
If Not IsEmpty(cell) Then
a() = Split(cell.Value2, ",")
cell.Interior.Color = RGB(CInt(a(0)), CInt(a(1)), CInt(a(2)))
End If
Next cell
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function Color
' Purpose Determine the Background Color Of a Cell
' @Param rng Range to Determine Background Color of
' @Param formatType Default Value = 0
' 0 Integer
' 1 Hex
' 2 RGB
' 3 Excel Color Index
' Usage Color(A1) --> 9507341
' Color(A1, 0) --> 9507341
' Color(A1, 1) --> 91120D
' Color(A1, 2) --> 13, 18, 145
' Color(A1, 3) --> 6
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' https://stackoverflow.com/questions/24132665/return-rgb-values-from-range-interior-color-or-any-other-color-property
Public Function GetColour(ByRef Target As Range, Optional formatType As Integer = 0) As Variant
Dim colorVal As Variant
colorVal = Cells(Target.Row, Target.Column).Interior.Color
Select Case formatType
Case 1
GetColour = Hex(colorVal)
Case 2
GetColour = (colorVal Mod 256) & ", " & ((colorVal \ 256) Mod 256) & "," & (colorVal \ 65536)
Case 3
GetColour = Cells(Target.Row, Target.Column).Interior.ColorIndex
Case Else
GetColour = colorVal
End Select
End Function
Private Sub ListMSO_2016_Colours()
Dim Target As Range
Dim i As Long
Dim a() As String
Dim colours(1 To 60) As Variant
colours(1) = "255, 255,255"
colours(2) = "242, 242,242"
colours(3) = "217, 217,217"
colours(4) = "191, 191,191"
colours(5) = "166, 166,166"
colours(6) = "128, 128,128"
colours(7) = "0, 0,0"
colours(8) = "128, 128,128"
colours(9) = "89, 89,89"
colours(10) = "64, 64,64"
colours(11) = "38, 38,38"
colours(12) = "13, 13,13"
colours(13) = "231, 230,230"
colours(14) = "208, 206,206"
colours(15) = "174, 170,170"
colours(16) = "117, 113,113"
colours(17) = "58, 56,56"
colours(18) = "22, 22,22"
colours(19) = "68, 84,106"
colours(20) = "214, 220,228"
colours(21) = "172, 185,202"
colours(22) = "132, 151,176"
colours(23) = "51, 63,79"
colours(24) = "34, 43,53"
colours(25) = "68, 114,196"
colours(26) = "217, 225,242"
colours(27) = "180, 198,231"
colours(28) = "142, 169,219"
colours(29) = "48, 84,150"
colours(30) = "32, 55,100"
colours(31) = "237, 125,49"
colours(32) = "252, 228,214"
colours(33) = "248, 203,173"
colours(34) = "244, 176,132"
colours(35) = "198, 89,17"
colours(36) = "131, 60,12"
colours(37) = "165, 165,165"
colours(38) = "237, 237,237"
colours(39) = "219, 219,219"
colours(40) = "201, 201,201"
colours(41) = "123, 123,123"
colours(42) = "82, 82,82"
colours(43) = "255, 192,0"
colours(44) = "255, 242,204"
colours(45) = "255, 230,153"
colours(46) = "255, 217,102"
colours(47) = "191, 143,0"
colours(48) = "128, 96,0"
colours(49) = "91, 155,213"
colours(50) = "221, 235,247"
colours(51) = "189, 215,238"
colours(52) = "155, 194,230"
colours(53) = "47, 117,181"
colours(54) = "31, 78,120"
colours(55) = "112, 173,71"
colours(56) = "226, 239,218"
colours(57) = "198, 224,180"
colours(58) = "169, 208,142"
colours(59) = "84, 130,53"
colours(60) = "55, 86,35"
Set Target = Range("J1")
Target.Value = "MSO_2016"
For i = LBound(colours) To UBound(colours)
a() = Split(colours(i), ",")
With Target.Offset(i, 0)
.Value = colours(i)
.Interior.Color = RGB(CInt(a(0)), CInt(a(1)), CInt(a(2)))
End With
Next i
Target.CurrentRegion.Columns.AutoFit
Target.Activate
End Sub
Private Sub ListMSO_2013_Colours()
Dim Target As Range
Dim i As Long
Dim a() As String
Dim colours(1 To 60) As Variant
colours(1) = "255, 255,255"
colours(2) = "242, 242,242"
colours(3) = "216, 216,216"
colours(4) = "191, 191,191"
colours(5) = "165, 165,165"
colours(6) = "127, 127,127"
colours(7) = "0, 0,0"
colours(8) = "127, 127,127"
colours(9) = "89, 89,89"
colours(10) = "63, 63,63"
colours(11) = "38, 38,38"
colours(12) = "12, 12,12"
colours(13) = "238, 236,225"
colours(14) = "221, 217,195"
colours(15) = "196, 189,151"
colours(16) = "147, 137,83"
colours(17) = "73, 68,41"
colours(18) = "29, 27,16"
colours(19) = "31, 73,125"
colours(20) = "198, 217,240"
colours(21) = "141, 179,226"
colours(22) = "84, 141,212"
colours(23) = "23, 54,93"
colours(24) = "15, 36,62"
colours(25) = "79, 129,189"
colours(26) = "219, 229,241"
colours(27) = "184, 204,228"
colours(28) = "149, 179,215"
colours(29) = "54, 96,146"
colours(30) = "36, 64,97"
colours(31) = "192, 80,77"
colours(32) = "242, 220,219"
colours(33) = "229, 185,183"
colours(34) = "217, 150,148"
colours(35) = "149, 55,52"
colours(36) = "99, 36,35"
colours(37) = "155, 187,89"
colours(38) = "235, 241,221"
colours(39) = "215, 227,188"
colours(40) = "195, 214,155"
colours(41) = "118, 146,60"
colours(42) = "79, 97,40"
colours(43) = "128, 100,162"
colours(44) = "229, 224,236"
colours(45) = "204, 193,217"
colours(46) = "178, 161,199"
colours(47) = "95, 73,122"
colours(48) = "63, 49,81"
colours(49) = "75, 172,198"
colours(50) = "219, 238,243"
colours(51) = "183, 221,232"
colours(52) = "146, 205,220"
colours(53) = "49, 133,155"
colours(54) = "32, 88,103"
colours(55) = "247, 150,70"
colours(56) = "253, 234,218"
colours(57) = "251, 213,181"
colours(58) = "250, 192,143"
colours(59) = "227, 108,9"
colours(60) = "151, 72,6"
Set Target = Range("M1")
Target.Value = "MSO_2013"
For i = LBound(colours) To UBound(colours)
a() = Split(colours(i), ",")
With Target.Offset(i, 0)
.Value = colours(i)
.Interior.Color = RGB(CInt(a(0)), CInt(a(1)), CInt(a(2)))
End With
Next i
Target.CurrentRegion.Columns.AutoFit
Target.Activate
End Sub