How to change properties of selected shapes

[Karin Carlson]

I've been looking all over to find some code that will allow me to alter the properties of one or more shapes that I manually select.



In plain English, this is what I would like it to do:

for the selected shape(s), change the following properties:
line width and color
fill color
size (width/height)
shape type (e.g., rectangle to circle)


This seems like it would be easy but none of the code I've tried seems to work at all.

(For clarification, I'd like to do this for both inline shapes and shapes that are "floating", but I realize that they are different in Word, so I don't need to do these at the same time or with the same code.)

Help would be greatly appreciated!!

Karin

[macropod]

Assuming you're referring to autoshapes, all of this is possible with VBA but, without knowing precisely what you want to change, it's impossible to supply the code. As a demo:

Sub Demo()
With ActiveDocument.Shapes(1)
  .AutoShapeType = msoShapeOval 'msoShapeRectangle
  .Fill.ForeColor.RGB = RGB(255, 255, 0)
  .Fill.BackColor.RGB = RGB(127, 0, 0)
  .Fill.TwoColorGradient msoGradientFromCenter, 2
  .Fill.Transparency = 0.25
  .Line.Weight = 2
  .Height = InchesToPoints(1.25)
  .Width = InchesToPoints(1.5)
End With
End Sub

[Karin Carlson]

Hi there- thanks for that. I had bits and pieces of that, but have two more questions:

1 - Because of the index for the shape, it's only doing the first shape in the document, which is (I assume) the first shape in the collection. How can I select a shape or multiple shapes and then run the macro and have it affect only the shapes I select?

2 - I can't find a method to apply a text (paragraph) style to the text inside a shape.

Thanks!

[macropod]

For a single selected shape you could change:
With ActiveDocument.Shapes(1)
to:
With Selection.ShapeRange(1)
You could, of course, change the index # to refer to the 2nd, 3rd, etc. Shape in the document or selection, as appropriate. For multiple shapes, you'd need to implement a loop.

To work with text in a shape, refer to its .TextFrame.TextRange property.

[Karin Carlson]

Ah, brill, thanks. I am mostly okay with figuring out properties, but the ShapeRange thing is new. Thanks so much for your speedy reply.

[Karin Carlson]

Thank you very much for your help -- for the benefit of others and for posterity, here's what I am using. I have two sub routines. (Added a 3rd which includes a loop so it does all the selected shapes.)

1 - Changes a selected shape with a number in it to a cute little red circle .18" h/w, and applies a style (Stepcircles) to the number inside the circle.

Sub redCircle()
With Selection.ShapeRange(1)
    .AutoShapeType = msoShapeOval
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.BackColor.RGB = RGB(255, 255, 255)
    .Line.Weight = 1
    .Line.ForeColor.RGB = RGB(255, 0, 0)
    .Height = InchesToPoints(0.18)
    .Width = InchesToPoints(0.18)
    .TextFrame.TextRange.Style = "Stepcircles"
    .TextFrame.MarginBottom = 0
    .TextFrame.MarginRight = 0
    .TextFrame.MarginTop = 0
    .TextFrame.MarginLeft = 0
    
    End With
End Sub

2 - Changes a selected shape to a red rectangle that has a 1pt border.

Sub redOutlineOneRectangle()
    With Selection.ShapeRange(1)
        .AutoShapeType = msoShapeRectangle
        .Line.Weight = 1
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        End With

End Sub

3 - Same as #1, but will do all the shapes in the selection.

Sub redCircles()

Dim allShapes As ShapeRange
Dim myShape As Shape

Set allShapes = Selection.ShapeRange

For Each myShape In allShapes
    
  
With myShape
    .AutoShapeType = msoShapeOval
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.BackColor.RGB = RGB(255, 255, 255)
    .Line.Weight = 1
    .Line.ForeColor.RGB = RGB(255, 0, 0)
    .Height = InchesToPoints(0.18)
    .Width = InchesToPoints(0.18)
    .TextFrame.TextRange.Style = "Stepcircles"
    .TextFrame.MarginBottom = 0
    .TextFrame.MarginRight = 0
    .TextFrame.MarginTop = 0
    .TextFrame.MarginLeft = 0
    
    End With
    
Next myShape
End Sub