Need Help for VBA Macro that inserts an object into a word table

[rodell]

Trying to create a macro that will insert an object (circle) into a word table
Basically what I am doing is exporting data from another program into a word table. I have one column that indicates the status of a project
For example if the status is complete I need to indicate that with a green circle. Currently the program I am using ( HP QC) will not export it that way. I have to modify to export it to word in text. For example, a completed project once exported to word will have the text "Green" in the appropriate cell to indicate a completed status. What I would like to do is to create a macro that will identify the status cells or the entire table to look for any cell that has the text "Green, Red, Black etc and respond clearing the cell and inserting a circle that corresponds to the appropriate color. I have found some examples of VBA code "Sub DrawMyCircle() that has included dimensions, but all it does is just inserts it into the word document itself. I would like to have it in a specific cell. I am fairly new at VBA and by no means an expert yes. Need help. Not sure if this is even feasible. Below is an example of one of the examples of code I have found, but like I said, I have not been able to figure out how to modify to respond to a particular cell

Sub DrawMyCircle()
Dim c As Word.Cell
If Selection.Information(wdWithInTable) Then
For Each c In Selection.Tables(1).Range.Cells
If IsNumeric(Left(c.Range.Text, Len(c.Range.Text) - 1)) Then
If Val(c.Range.Text) > -0 Then
c.Shading.BackgroundPatternColor = wdColorGreen
Else
c.Shading.BackgroundPatternColor = wdColorRed
End If
Else 'set nonnumeric to white
c.Shading.BackgroundPatternColor = wdColorWhite

With ThisDocument.Shapes.AddShape(Type:=msoShapeOval, _
Left:=InchesToPoints(0.125), _
Top:=InchesToPoints(0.125), _
Width:=InchesToPoints(0.125), _
Height:=InchesToPoints(0.125))

.Fill.Visible = msoFalse
With .Line
.Weight = 1.75
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.BackColor.RGB = RGB(255, 255, 255)
End If
Next

[gmayor]

Insert the green circle into a document. Change the wrap to InLine. Select and press ALT+F3 save in the normal template as an autotext entry called CircleGreen. Change the colour to red and save that as an autotext entry called CircleRed, repeat for any other colours you require. You can then use the following macro to replace the cell contents that contain the words red, green etc with the appropriate autotext entries, using the following macro.

The macro looks in all cells, but you can restrict to a column if you wish.



Option Explicit
Sub AddCircles()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
For Each oTable In ActiveDocument.Tables
For Each oCell In oTable.Range.Cells
Set oRng = oCell.Range
oRng.End = oRng.End - 1
If InStr(1, LCase(oRng.Text), "green") > 0 Then
oRng.Delete
NormalTemplate.BuildingBlockEntries("CircleGreen").Insert oRng
ElseIf InStr(1, LCase(oRng.Text), "red") > 0 Then
oRng.Delete
NormalTemplate.BuildingBlockEntries("CircleRed").Insert oRng
ElseIf InStr(1, LCase(oRng.Text), "black") > 0 Then
oRng.Delete
NormalTemplate.BuildingBlockEntries("CircleBlack").Insert oRng
End If
Next oCell
Next oTable
lbl_Exit:
Exit Sub
End Sub