Excel VBA code for Process Mapping - vba

Question

I have to create process maps in excel often and am trying to cut down on the excessive time it takes. instead of creating each shape and entering or pasting the text into the shape, with often 100 + steps. I am trying to write a code that will create a shape with the text from column D and will continue to do so until there is no text in the cell in column A. I have been able to create code to create the shapes but I cannot seem to have the text populate correctly in the separate blocks. Below is the code I have so far:
Sub addshapewithtext()
Dim BlankFound As Boolean
Dim x As Long
Dim w As Worksheet
Dim s As Shape
Dim t As Variant
Do While BlankFound = False
x = x + 1
Set t = Cells(x, "d")
Set w = ActiveSheet
Set s = w.Shapes.addshape(msoShapeFlowchartProcess, 200 + x * 200, 100, 100, 100)
'format shape
s.Fill.ForeColor.RGB = RGB(300, 300, 300)
s.Line.ForeColor.RGB = RGB(0, 0, 0)
s.Line.Weight = 3
'transparency
s.Fill.Transparency = 0
'add text from list
s.OLEFormat.Object.Formula = t
If Cells(x, "A").Value = "" Then
BlankFound = True
End If
Loop
End Sub
thank you for your help

Answer 1

Change s.OLEFormat.Object.Formula = t to s.OLEFormat.Object.Text = t
You may want to add in font size and color for the text in your shape as well
REVISED TO ADD
I went ahead and tweaked the procedure slightly and tested it:
Sub addshapewithtext()
Dim BlankFound As Boolean
Dim x As Long
Dim w As Worksheet
Dim s As Shape
Dim t As Variant
x = 1
Do Until Cells(x, "A").Value = ""
Set t = Cells(x, "d")
Set w = ActiveSheet
Set s = w.Shapes.AddShape(msoShapeFlowchartProcess, 200 + x * 200, 100, 100, 100)
'format shape
s.Fill.ForeColor.RGB = RGB(300, 300, 300)
s.Line.ForeColor.RGB = RGB(0, 0, 0)
s.Line.Weight = 3
'transparency
s.Fill.Transparency = 0
'add text from list
s.OLEFormat.Object.Text = t
If Cells(x, "A").Value = "" Then BlankFound = True
x = x + 1
Loop
End Sub

Answer 2

The code from the answer before me works great, but the text does not show because it's white.
To show the text in the process blocks you can give them a color with:
s.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
Code:
Sub addshapewithtext()
Dim BlankFound As Boolean
Dim x As Long
Dim w As Worksheet
Dim s As Shape
Dim t As Variant
x = 1
Do Until Cells(x, "A").Value = ""
Set t = Cells(x, "d")
Set w = ActiveSheet
Set s = w.Shapes.AddShape(msoShapeFlowchartProcess, 200 + x * 200, 100, 100, 100)
'format shape
s.Fill.ForeColor.RGB = RGB(300, 300, 300)
s.Line.ForeColor.RGB = RGB(0, 0, 0)
s.Line.Weight = 3
'Add color to text in process block
s.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
'transparency
s.Fill.Transparency = 0
'add text from list
s.OLEFormat.Object.Text = t
If Cells(x, "A").Value = "" Then BlankFound = True
x = x + 1
Loop
End Sub