Ever played around with colors in excel?
You might feel the weirdness in it, but why not give it a try when you have a chance to do so.
Play, Fill, Pattern around the space using Colors from the Palette !!!
The key reason behind writing this blog is to provide a practical example of using Relative Referencing in Excel VBA. However the blog covers many other things as well, not just the Relative Referencing concept .
Please download the demo tool (unlocked version) by click on the link : Drawing File
First, let's see how the tool works !
This is how the interface looks like:
Please click to enlarge |
Now, to understand, how this Paint Board has been created :
We would take reference of the number shown in the interface picture shown above
Point 1: Color Palette
Insert Color Filled Rectangular Boxes of your choice and assign a Macro to each of them and also a number which can be stored in a particular cell.
So each time a color filled button is clicked, the Macro gets executed and also the number that is assigned to the button gets stored on to a particular cell linked.
I have built a Macro for the same wherein it fetches the reference value from the cell that is linked to the Color filled Button and executes it accordingly.
Sub palette()
If Range("AB1").Value = 1 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
In the above macro, the Cell "AB1" has been assigned to this particular color box and number 1 has been assigned and stored.
Point 2: Drawing Board
For that, the "Not Intersect" functionality has been used. It's as cool as ice but it doesn't melt.
Jokes apart, let just see how the code looks like :
Sub onestepdownleftright()
If Not Intersect(ActiveCell, Range("C11:L28")) Is Nothing Then
ActiveCell.Offset(1, 1).Range("a1").Select
Call palette
Range("ad1").Value = 2
Call color_button
Else: MsgBox ("Please use the Workspace as outlined for Pattern Filling")
End If
End Sub
The bold and pink highlighted part of the above macro would restrict the painting within the defined drawing board. This line has been added in all the pattern macros.
Point 3: The Eraser
This is an "Erase-a-Cell" button which erases the active / selected cell/range. Its scope has also been defined using again the "Not Intersect" Functionality as elaborated above.
Sub eraser()
If Not Intersect(ActiveCell, Range("C11:M29")) Is Nothing Then
ActiveCell.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub
Point 4: Reset Button
The Reset Button clears the drawing board as a whole on one click.
In the code, mentioned below, I have just filled the entire drawing board area with White Color but not cleared it using Clear/ Clearcontents options. The reason, why I haven't used the later, is because Clearcontents clears any cell content but not the format, while the Clear option clears the entire format including the outline marked.
Sub clear()
Application.ScreenUpdating = False
Range("c11:m29").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("p15").Select
Range("ad1").Value = 0
For i = 1 To 8
ActiveSheet.Shapes("Rectangle " & i).Select
Selection.ShapeRange.fill.ForeColor.RGB = RGB(89, 89, 89)
Next i
Range("h19").Select
End Sub
Point 5: Fill-a-Cell
Fill-a-Cell button fills in the active cell corresponding to the colour chosen from the Color Palette.
Sub fill()
If Not Intersect(ActiveCell, Range("C11:M29")) Is Nothing Then
ActiveCell.Select
Call palette
End If
End Sub
Point 6: Pattern Buttons
Various button have been designed with varied Offset function fused with Relative Referencing.
The Offset function works in relative reference of the active cell in terms of the shift of the rows & columns. For example an offset of (1,-2) would signify that from the active cell position it would move one Row down and two Columns to the Left.
Sub up()
If Not Intersect(ActiveCell, Range("C12:M29")) Is Nothing Then
ActiveCell.Offset(-1, 0).Range("a1").Select
Call palette
Range("ad1").Value = 5
Call color_button
Else: MsgBox ("Please use the Workspace as outlined for Pattern Filling")
End If
End Sub
This concludes the descriptive part of the Paint Board. I would like all of you to go through the same and come up with any query or suggestion for the improvement in the board. Also if there are any such fun filled stuff which can be created using Excel / VBA please do feel free to reach out. We welcome all the excel freaks to be part of this family.
Till then, let the Color flow, and
may you come out with flying colours every time !
Enjoy reading our other articles and stay tuned with us.
Kindly do provide your feedback in the 'Comments' Section and share as much as possible.
No comments:
Post a Comment
Do provide us your feedback, it would help us serve your better.