Reputation: 13
I have a document that has a number of rectangle shapes. I want to replace each of those with a TextBox in exactly the same place. My starting point is working with an existing known shape I want to replace with a textbox (later I'll add further automation to process the selected shape or all shapes).
This is my code so far:
Sub Macro3()
'
' Macro3 Macro
'
'
Dim shp As Shape
Dim Box As Shape
For Each shp In ActiveDocument.Shapes.Range(Array("Group 1928"))
shp.Select
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=shp.Left, Top:=shp.Top, Width:=shp.Width, Height:=shp.Height)
Box.RelativeHorizontalPosition = shp.RelativeHorizontalPosition
Box.RelativeVerticalPosition = shp.RelativeVerticalPosition
Box.TextFrame.TextRange.Text = "Some text"
Next shp
End Sub
I've tried setting a number of other properties but the textbox always appears and stays at the top centre of the document page.
Thank you for any guidance you can offer.
Regards Tim
Upvotes: 1
Views: 309
Reputation: 13490
For example:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, rt As Long, rl As Long, wf As Long, Shp As Shape
With ActiveDocument
For i = .Shapes.Count To 1 Step -1
With .Shapes(1)
If .Type = msoAutoShape Then
wf = .WrapFormat.Type
rt = .TopRelative
rl = .LeftRelative
Set Shp = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height, Anchor:=.Anchor)
With Shp
.WrapFormat.Type = wf
.TopRelative = rt
.LeftRelative = rl
.TextFrame.TextRange.Text = "Hello World"
End With
.Delete
End If
End With
Next
End With
Application.ScreenUpdating = True
End Sub
Upvotes: 1
Reputation: 421
Try this. In my opinion you don't need to crate a TextBox, you can simply change the existing box as follow:
Dim shp As Shape
Dim Box As Shape
scount = ActiveDocument.Shapes.Count
For i = 1 To scount
Set shp = ActiveDocument.Shapes(i)
shp.TextFrame.TextRange.Text = "Some txt"
shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
shp.Line.ForeColor.RGB = RGB(255, 255, 255)
shp.TextFrame.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
Next i
Upvotes: 0