none
Multi shapes into one shape RRS feed

  • Question

  • I have the following macro that creates a revision bar with a rev triangle. I do this using three shapes. Is there a way at the end of this macro to combine these three shapes into one new shape? This will make it easier to do searches and deletes.

     

     

    Sub RevBarWithTriangles()

    Dim RevNumber As String

    Dim lineNew As Shape

    Dim TriangleNew As Shape

    Dim Deletable As Shape

    Dim NumberNew As Shape

    Dim ThisRange As Range

    Set ThisRange = Selection.Range

     

    On Error GoTo endthis

    For Each aVar In ActiveDocument.Variables

        If aVar.Name = "idx" Then

            num = aVar.Index

            Exit For

        End If

    Next aVar

     

    If num = 0 Then

        ActiveDocument.Variables.Add Name:="idx", Value:=0

    End If

        idx = ActiveDocument.Variables("idx").Value + 1

        i = Selection.Information(wdVerticalPositionRelativeToPage)

        j = InchesToPoints(InputBox("BAR LENGTH {In Inches}:"))

        ActiveDocument.Shapes.AddLine(562, i, 562, j + i).Name = "vline" & idx

        Set TriangleNew = ActiveDocument.Shapes.AddShape(msoShapeIsoscelesTriangle, 565, i + (LineLength / 1) - 5, 19, 19)

        TriangleNew.Name = "RevTriangle " & Rnd(99999)

        TriangleNew.Select

        Selection.ShapeRange.Fill.Transparency = 1#

         

        RevNumber = InputBox("Rev Number?")

        Set NumberNew = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 564.5, i + (LineLength / 1) - 1, 19, 19)

        NumberNew.Select

        NumberNew.Name = "RevNumber " & Rnd(99999)

        Selection.TypeText Text:=RevNumber

        Selection.WholeStory

        Selection.Font.Size = 8

        Selection.ShapeRange.Fill.Visible = msoFalse

        Selection.ShapeRange.Fill.Transparency = 1#

        Selection.ShapeRange.TextFrame.AutoSize = True

        Selection.ShapeRange.TextFrame.WordWrap = True

        Selection.ShapeRange.Line.Visible = msoFalse

        Selection.ShapeRange.ZOrder msoSendToBack

        Set Deletable = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 564, RangeStart + (LineLength / 2) - 4, 15, 15)

        Deletable.Delete

        ThisRange.Select

        ActiveDocument.Variables("idx").Value = idx

    endthis:

    Set aVar = Nothing

    End Sub

     

    Friday, January 6, 2012 10:05 PM

Answers

  • I got this to work by changing the following three lines to this:

     

    ActiveDocument.Shapes.AddLine(562, i, 562, j + i).Name = "vline"

    TriangleNew.Name = "RevTriangle"

    NumberNew.Name = "RevNumber"

     

    And adding these three lines after   ThisRange.Select:

     

    ActiveDocument.Shapes.Range(Array("vline", "RevNumber", "RevTriangle")).Group.Select

    Selection.ShapeRange.Group.Select

    Selection.ShapeRange.Group.Name = "Group" & idx

     

     

    • Marked as answer by fuzzhead58 Saturday, January 7, 2012 10:20 PM
    Saturday, January 7, 2012 10:20 PM

All replies

  • Which version of Word are you using?

    There is a Group method that would hold grouped shapes together as a single unit. It's not one graphic, but it will behave more or less like one when the user clicks and drags, for example.

    Word has no facility to create a single graphic from multiple objects - it's not a graphics program. But there's no reason (technically) you couldn't create this in Paint (or another graphics program) then use the Shapes.AddPicture method to insert it into your documents. Or save the graphic as a Building Block in a template and insert it from there.


    Cindy Meister, VSTO/Word MVP
    • Proposed as answer by Stefan BlomMVP Sunday, January 8, 2012 12:03 AM
    Saturday, January 7, 2012 7:46 AM
    Moderator
  • I am using Word 2010. How would I group the shapes after they are created?
    Saturday, January 7, 2012 2:32 PM
  • I got this to work by changing the following three lines to this:

     

    ActiveDocument.Shapes.AddLine(562, i, 562, j + i).Name = "vline"

    TriangleNew.Name = "RevTriangle"

    NumberNew.Name = "RevNumber"

     

    And adding these three lines after   ThisRange.Select:

     

    ActiveDocument.Shapes.Range(Array("vline", "RevNumber", "RevTriangle")).Group.Select

    Selection.ShapeRange.Group.Select

    Selection.ShapeRange.Group.Name = "Group" & idx

     

     

    • Marked as answer by fuzzhead58 Saturday, January 7, 2012 10:20 PM
    Saturday, January 7, 2012 10:20 PM