提取文本框中的文本

Question

我是 VBA 编码的新手，我正在尝试提取文本框中的文本并在范围段落之前插入文本框文本..

这是我到目前为止想出的：

Private Sub Document_New()
   Dim shp As Shape
   Dim oRngAnchor As Range
   Dim sString As String
   For Each shp In ActiveDocument.Shapes
       If shp.Type = msoTextBox Then
            shp.Select
            Selection.ShapeRange.TextFrame.TextRange.Select
           sString = Left(shp.TextFrame.TextRange.Text, _
             shp.TextFrame.TextRange.Characters.Count - 1)
           If Len(sString) > 0 Then
               Set oRngAnchor = shp.Anchor.Paragraphs(1).Range
               oRngAnchor.InsertBefore _
                 "*" & sString & "*"
           End If
           shp.Delete
       End If
   Next shp
End Sub

但是它会跳过一些文本框，请查看并告诉我是否有办法从所有文本框中提取文本..

非常感谢您的帮助..

谢谢。

Answer 1

请尝试下一个代码。当在形状之间迭代并在迭代期间删除其中一个形状时，形状参考将丢失。最后必须删除形状。除此之外，无需选择：

Sub takeTextFromTextBoxes()
   Dim shp As Shape, oRngAnchor As Range, sString As String
   Dim shpR As ShapeRange, arrShp As Variant, k As Long, i As Long 'new declarations
   
   ReDim arrShp(ActiveDocument.Shapes.Count)
   For Each shp In ActiveDocument.Shapes
       i = i + 1
       If shp.Type = msoTextBox Then
           sString = Left(shp.TextFrame.TextRange.Text, _
             shp.TextFrame.TextRange.Characters.Count - 1)
           If Len(sString) > 0 Then
               Set oRngAnchor = shp.Anchor.Paragraphs(1).Range
               oRngAnchor.InsertBefore "*" & sString & "*"
           End If
           arrShp(k) = i: k = k + 1
       End If
   Next shp
   ReDim Preserve arrShp(k - 1)
   Set shpR = ActiveDocument.Shapes.Range(arrShp)
   shpR.Delete
End Sub

提取文本框中的文本

Extract text in Text boxes

vba

textbox

ms-word