如何在 Word 中定位刚刚添加到页面的文本框

问题描述

我有一个包含多个矩形形状的文档。我想在完全相同的地方用 TextBox 替换每个。 我的出发点是使用我想用文本框替换的现有已知形状（稍后我将添加进一步的自动化来处理选定的形状或所有形状）。

这是我目前的代码：

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

我尝试设置了许多其他属性，但文本框始终出现并停留在文档页面的顶部中心。

感谢您提供的任何指导。

问候 提姆

解决方法

例如：

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

,

试试这个。在我看来，你不需要创建一个 TextBox，你可以简单地改变现有的框，如下所示：

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)
    shp.TextFrame.TextRange.Font.Fill.ForeColor.RGB = RGB(0,0)
Next i