Consulting

Results 1 to 2 of 2

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

  1. #1
    VBAX Regular
    Joined
    Mar 2015
    Posts
    8
    Location

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

    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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •