Diamond painting in Excel

Bored during COVID lockdown? Here is how you can virtually diamond paint using Excel! For the sake of it, I’ll show how to use a pallet and VBA to allow changing the color fast 🙂

1. Set your model as background. Search for a diamond paint model and use it as background in Excel: Page Layout=> Background and select the picture. It helps if it has a white frame. Also, you can use any photo.

2. Define your pallet as table. On first column add a header and then numbers starting from 0. Select the cells and transform to table with Ctrl+T. On Design=> Table Style, select None (no borders, no colors). Color each table cell with one of the colors matching your picture.

Tip: blank cell in Excel is assimilated to zero so you could use 0 for blank

3. Shrink rows and columns to create a gridline to fit the size of the diamond painting model. In this example I used 4 pixels. Do not include the rows containing the pallet or its column. Select the pallet and change the font to 4 (you have to type 4 and enter, it’s not in the dropdown list).

4. Zoom-in to 300% (in case you sized rows and columns to 4 pixels), and size the first column to align to the edge of the background picture. Go with the first picture that is covered correctly by gridline. You can delimit it with a thick border.

Now, shrink the pallet’s rows as much as you can still see the numbers.

Note: Remember the zoom you used in case you need to zoom in or out to check your work!

5. Lock the pallet on top. Select the first row beneath the pallet and View=> Freeze panes. It will keep your pallet visible since your chosen area is way below.

Now you are ready to diamond paint! It will look something like this:

For the VBA part you need one more thing to make sure any picture can be accommodated: mark the first cell in the area you are “painting”.

Select a cell close to the pallet (let’s say C1) and name it StartCell. Here type the reference of the first cell in the area you will paint (case insensitive).

6. Add the magic button. Open VBA editor (alt+F11) and Insert=> Module and copy the following code:

 
 
  1. Option Explicit
  3. Sub SetColor()
  4.     Dim rng As Range, cl As Range
  5.     Dim dColor As New Dictionary
  6.     Dim diamond As Boolean
  7. ' needs reference to Microsoft Scripting Runtime  
  8.    
  9.     ActiveSheet.Unprotect
  10.     Set dColor = GetColorsDictionary
  11.     Set rng = Range("B13").CurrentRegion
  12.     If MsgBox("If you want DIAMOND like picture, select Yes, and for plain color select No." & vbCr & _
  13.             "Please note that diamond takes longer time and the color is revealed only when ready", vbYesNo + vbInformation) = vbYes Then diamond = True
  14.     For Each cl In rng
  15.         If dColor.Exists(cl.Value) Then
  16.             If diamond Then
  17.                 Application.ScreenUpdating = False
  18.                 With cl.Interior
  19.                     .Pattern = xlPatternRectangularGradient
  20.                     .Gradient.RectangleLeft = 0.5
  21.                     .Gradient.RectangleRight = 0.5
  22.                     .Gradient.RectangleTop = 0.5
  23.                     .Gradient.RectangleBottom = 0.5
  24.                     .Gradient.ColorStops.Clear
  25.                 End With
  26.                 With cl.Interior.Gradient.ColorStops.Add(0)
  27.                     .Color = 16777215
  28.                     .TintAndShade = 0
  29.                 End With
  30.                 With cl.Interior.Gradient.ColorStops.Add(1)
  31.                     .Color = dColor(cl.Value)
  32.                     .TintAndShade = 0
  33.                 End With
  34.                 Application.ScreenUpdating = True
  35.             Else
  36.                 cl.Interior.Color = dColor(cl.Value)
  37.             End If
  38.             cl.Font.Color = dColor(cl.Value)
  39.            
  40.         End If
  41.     Next cl
  42.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
  44. End Sub
  46. Function GetColorsDictionary()
  47.     Dim i, tbl As ListObject
  48.     Dim rslt As New Dictionary
  49.    
  50.     Set tbl = Sheets(1).ListObjects(1)
  51.     For i = 1 To tbl.DataBodyRange.Rows.Count
  52.         If Not rslt.Exists(tbl.DataBodyRange(i, 1).Value) Then _
  53.             rslt.Add tbl.DataBodyRange(i, 1).Value, tbl.DataBodyRange(i, 1).Interior.Color
  54.     Next i
  55.    
  56.     Set GetColorsDictionary = rslt
  57. End Function

Add a button close to pallet and assign it the SetColor macro.

7. How to “paint”. Either type the color code from the pallet or copy paste the cell containing the code. While you fill in areas, you might see that the color on the pallet doesn’t match the picture. You can change the color on the palet and click on the button.

Note: every time you click the button, the sheet is protected. If you want to make changes, right-click on the sheet’s tab and select Unprotect.

From time to time, you can remove background (Page Layout menu) to see how it will look like. When filling in, remember to keep the same zoom you used to define gridline.

At the end, go to View and uncheck Gridlines, Headings, Formula Bar.

The macro allows to fill in either with plain color or gradient to mimic diamonds. First picture shows a plain color filling.

And this is how it looks with gradient filling:

Hope you enjoy it! If you want to start with this example, download the xlsx file (no macros) and add the VBA part yourself: DiamondPaintingExcel. You can use the same file to load other background picture.

Add a Comment

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.