Option Explicit 
Public NewForm As Object, NewClass As Object 
 
 'This code requires that the user permit programmatical access to the VBA Project in later versions of Excel
 
 'to do this, from the normal Excel menu
 
 'Tools - Macro - Security
 'tab to Trusted Publishers
 'tick the checkbox next to "Trust access to the Visual Basic Project"
 
Sub ShowForm() 
     '****** This sub calls the modules to create the userform and add the class module ******
     
     'Create UserForm
    Call CreateForm 
     ' Add UserForm code and Class Module
    Call AddClass 
     
     ' **** kludgy code to get class module working with UserForm in Designer Mode ****
    VBA.UserForms.Add (NewForm.Name) 
    UserForms(1).Hide 
    UserForms(1).Show 
     
     'Remove form and class module
    ThisWorkbook.VBProject.VBComponents.Remove vbcomponent:=NewForm 
    ThisWorkbook.VBProject.VBComponents.Remove vbcomponent:=NewClass 
End Sub 
Private Sub CreateForm() 
     'This module creates a Temporary UserForm in the ActiveWorkbook to pop up the colours
     'of the Activeorkbook palette
     
     '***** A Reference is needed to Microsoft Forms 2.0 Object Library *****
     
     'Requires Excel 2000 or higher as it uses Array
     
    Dim NewImage As MSForms.Image 
    Dim iRow As Integer, iCol As Integer 
    Dim PaletteColours 
    Dim TopPos As Integer, LeftPos As Integer 
     
     'Add a new Forms module
    Set NewForm = ThisWorkbook.VBProject.VBComponents.Add(3) 
     
     'Set the Form size
    NewForm.Properties("Width") = 200 
    NewForm.Properties("Height") = 195 
    TopPos = 6 
     
     'This array corresponds to the order of colours in the ActiveWorkbook palette
    PaletteColours = Array("1", "9", "3", "7", "38", "17", "25", "53", "46", "45", "44", "40", _ 
    "18", "26", "51", "12", "43", "6", "36", "19", "27", "11", "5", "41", "33", "37", "22", "30", _ 
    "52", "10", "50", "4", "35", "20", "28", "49", "14", "42", "8", "34", "21", "29", "55", "47", _ 
    "13", "54", "39", "23", "31", "56", "16", "48", "15", "2", "24", "32") 
    ReDim Preserve PaletteColours(1 To 56) 
     
     'Add the images in 7 groups of 8 images
    LeftPos = 6 
    For iRow = 1 To 8 
        TopPos = 6 
        For iCol = 1 To 7 
            Set NewImage = NewForm.Designer.Controls.Add("forms.image.1") 
            With NewImage 
                .Width = 18 
                .Height = 18 
                .Left = LeftPos 
                .Top = TopPos 
                .BackColor = ActiveWorkbook.Colors(PaletteColours(iCol + (iRow - 1) * 7)) 
            End With 
            TopPos = TopPos + 24 
        Next iCol 
        LeftPos = LeftPos + 24 
    Next iRow 
End Sub 
 
Private Sub AddClass() 
     
     'Thus module adds the code to trigger a reponse to a click on a colour
     
    Dim NewMod As Object 
     'Delete the Class Module "Colours" if it exists
    On Error Resume Next 
    Set NewClass = ThisWorkbook.VBProject.VBComponents("Colour") 
    ThisWorkbook.VBProject.VBComponents.Remove NewClass 
    On Error GoTo 0 
     
     'Add the Class Module to capture the Image Click Event
    Set NewClass = ThisWorkbook.VBProject.VBComponents.Add(2) 
    NewClass.Name = "Colour" 
     
    With NewClass.CodeModule 
        .InsertLines 2, _ 
        "Public WithEvents ClrCntrl As Image" & Chr(13) & _ 
        "Private Sub ClrCntrl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)" & Chr(13) & _ 
        "ClrCntrl.SpecialEffect = fmSpecialEffectSunken" & Chr(13) & _ 
        NewForm.Name & ". backcolor = ClrCntrl.backcolor" & Chr(13) & _ 
        NewForm.Name & ".Caption = ""Control colour is "" & ClrCntrl.BackColor" & Chr(13) & _ 
        "End Sub" 
    End With 
     
     'Add the code for the UserForm
    Set NewMod = ThisWorkbook.VBProject.VBComponents(NewForm.Name) 
    With NewMod.CodeModule 
        .InsertLines 2, _ 
        "Private AA(1 To 56) As New Colour" & Chr(13) & _ 
        "Private Sub UserForm_Initialize()" & Chr(13) & _ 
        "Dim IM As Control, i as Long" & Chr(13) & _ 
        "i = 1" & Chr(13) & _ 
        "For Each IM In " & NewForm.Name & ".Controls" & Chr(13) & _ 
        "Set AA(i).ClrCntrl = IM" & Chr(13) & _ 
        "i = i + 1" & Chr(13) & _ 
        "Next" & Chr(13) & _ 
        "End Sub" 
    End With 
End Sub