Search This Blog

Friday 10 August 2012

WRITE YOUR TEXT IN SHAPES USING VBA

Select a cell (where you want to get the output). Paste the below code in the module and run it.


Sub DrawName()
Const pi = 3.1416
Dim i As Integer
Dim x As Single, 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 Integer
Dim StartTop As Integer

StartLeft = ActiveCell.Left
StartTop = ActiveCell.Top
sName = InputBox("Enter your text here")
n = 5
k = Len(sName)
sSize = Application.InchesToPoints(0.5)
Randomize Timer
z = 0#
For i = 1 To k
If Mid(sName, i, 1) <> " " Then
x = n * i / k
x = Application.InchesToPoints(x)
If Int(2 * Rnd) = 0 Then
z = z + 0.2
Else
z = z - 0.2
End If
y = Application.InchesToPoints(z)
Set sh = ActiveSheet.Shapes.AddShape _
(msoShapeSun, StartLeft + x, StartTop + y, sSize, sSize)

sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
sh.Fill.Visible = msoTrue
sh.TextFrame.Characters.Text = Mid(sName, i, 1)
sh.TextFrame.Characters.Font.Size = 12
sh.TextFrame.Characters.Font.Name = "Arial"
sh.TextFrame.Characters.Font.Bold = True
sh.TextFrame.Characters.Font.Color = vbBlack
End If
Next i
End Sub

Change the highlighted part to change the shape type. To know all shape types click on:
http://excelvbatipsforbeginners.blogspot.in/2012/08/all-shape-styles.html

After running this code, an inputbox will appear. Enter your text in the inputbox and press enter. Result would be like: (See the image below)


3 comments:

  1. Really awesome job done by you..till now....
    Keep shining with your knowledge

    ReplyDelete