How much time do you need to build something like this in Excel?
At least 20 minutes + a lot of lost nerves for the formatting. Unless you use VBA and you build it within some seconds 🙂
Pretty much the code is quite easy to be understood and modified – what is interesting is the name of the shape and the randomizing function. The name of the shape is taken from the Excel Macro Recorder and in my case I use two forms – msoShapeDownRibbon and msoShapeUpRibbon. The randomizing function is pretty obvious and can be reused in any project.
Something else, quite useful for working with forms – calculating their x and y position. In my case the y is standard, as all the shapes are in line and the x is calculated with the formula x = n * i / k, where n is a constant for the size of the shape, i is the position of the character in the string and k is the total characters of the string. To convert this numbers to points from inches (as far as Excel uses this metric system), we use the build-in function InchesToPoints – press F2 in VBE and write “InchesToPoints” for more information:
Last but not least, we use module calculation in order to select which shape to use – if i mod 2  returns 1, we use the msoShapeUpRibbon, and if it returns 0 we use the msoShapeDownRibbon. And it works! 🙂
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
Sub DrawName() Dim i As Integer Dim x As Single Dim y As Single Dim z As Single Dim rng As Range Dim n As Single Dim k As Integer Dim sSize As Single Dim sh As Shape Dim sName As String Dim StartLeft As Single Dim StartTop As Single StartLeft = ActiveCell.Left StartTop = ActiveCell.Top sName = "Welcome to Vitosh Academy !" n = 17 k = Len(sName) sSize = Application.InchesToPoints(1) For i = 1 To k If Mid(sName, i, 1) <> " " Then x = n * i / k x = Application.InchesToPoints(x) y = Application.InchesToPoints(z) If i Mod 2 = 1 Then Set sh = ActiveSheet.Shapes.AddShape(msoShapeUpRibbon, StartLeft + x, StartTop + y, sSize, sSize) Else Set sh = ActiveSheet.Shapes.AddShape(msoShapeDownRibbon, StartLeft + x, StartTop + y, sSize, sSize) End If sh.Fill.ForeColor.RGB = RGB(GiveRandom(150, 200), GiveRandom(200, 255), GiveRandom) sh.Fill.Visible = msoTrue sh.TextFrame.Characters.text = UCase(Mid(sName, i, 1)) sh.TextFrame.Characters.Font.Size = 20 sh.TextFrame.Characters.Font.Name = "Arial" sh.TextFrame.Characters.Font.Bold = True sh.TextFrame.Characters.Font.Color = RGB(0, 0, 0) sh.TextFrame2.VerticalAnchor = msoAnchorMiddle sh.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter End If Next i End Sub Function GiveRandom(Optional lowerBound As Integer = 100, Optional upperBound As Integer = 255) As Integer Randomize Timer GiveRandom = Int((upperBound - lowerBound + 1) * Rnd + lowerBound) End Function |
Enjoy it!