文本框移动到word文档vba宏中最后一页的顶部

Question

我正在为 word 文档编写一个 vba 宏。我使用 vba 宏为 word 文档生成文本框和文本。问题是文本框移动到最后一页的顶部，而不是停留在第一页。

我不知道我做错了什么。 我只需要将该文本框保留在第一页上。我真的需要包含该文本框。

下面是我的代码和输出图像

Dim wrdDoc As Object
Dim tmpDoc As Object
Dim WDoc As String
Dim myDoc As String


myDoc = "myTest"
WDoc = ThisDocument.Path & "\mydocument.docx"

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
    ' no current word application
    Set wdApp = CreateObject("Word.application")
    Set wrdDoc = wdApp.Documents.Open(WDoc)
    wdApp.Visible = True
Else
    ' word app running
    For Each tmpDoc In wdApp.Documents
        If StrComp(tmpDoc.FullName, WDoc, vbTextCompare) = 0 Then
            ' this is your doc
            Set wrdDoc = tmpDoc
            Exit For
        End If
    Next
    If wrdDoc Is Nothing Then
        ' not open
        Set wrdDoc = wdApp.Documents.Open(WDoc)
    End If
End If




ActiveDocument.Content.Select
Selection.Delete

With wdApp
    .Visible = True
    .Activate

    With .Selection
        Dim objShape As Word.Shape


        Set objShape2 = ActiveDocument.Shapes.addTextbox _
        (Orientation:=msoTextOrientationHorizontal, _
        Left:=400, Top:=100, Width:=250, Height:=60)
        With objShape2
            .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
            .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
            .Left = wdShapeRight
            .Top = wdShapeTop
            .TextFrame.TextRange = "This is nice and shine" & vbCrLf & "222"
            .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft
        End With
    End With

    With .Selection
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph

        For i = 1 To 40
            .TypeText i
            .TypeParagraph
        Next i
    End With
End With

Answer 1

Word Shape 对象必须定位到 Word 文档中的字符位置。它们将始终出现在锚字符所在的页面上，如果锚格式不是页面，它们将在页面上与锚字符相对移动。

当文档为“空”（一个单独的段落）时会出现一种特殊情况，因此有助于确保文档中包含多个字符。在下面的代码示例中，在将 TextBox - 添加到第一段之前插入了一个附加段落。

我对代码做了一些其他的调整：

1. 添加了On Error GoTo 0，以便显示错误消息。否则，调试将变得不可能。
2. 删除了 Word 应用程序的 With，因为在使用 Word 对象时不需要它
3. 声明并使用 Word Range 对象插入内容。与 Excel 一样，最好不要尽可能使用Selection。
4. 使用了您声明和实例化的 wrdDoc 对象，而不是 ActiveDocument。

这段代码在我的测试中运行良好，但我当然不能重现你的整个环境。

Dim wrdDoc As Object
Dim tmpDoc As Object
Dim WDoc As String
Dim myDoc As String

myDoc = "myTest"
WDoc = ThisDocument.Path & "\mydocument.docx"

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0

If wdApp Is Nothing Then
    ' no current word application
    Set wdApp = CreateObject("Word.application")
    Set wrdDoc = wdApp.Documents.Open(WDoc)
    wdApp.Visible = True
Else
    ' word app running
    For Each tmpDoc In wdApp.Documents
        If StrComp(tmpDoc.FullName, WDoc, vbTextCompare) = 0 Then
            ' this is your doc
            Set wrdDoc = tmpDoc
            Exit For
        End If
    Next

    If wrdDoc Is Nothing Then
        ' not open
        Set wrdDoc = wdApp.Documents.Open(WDoc)
    End If
End If

wdApp.Visible = True
wrdApp.Activate

Dim i As Long
Dim objShape2 As Word.Shape
Dim rng As Word.Range

Set rng = wrdDoc.Content
rng.Delete

With rng
    .InsertAfter vbCr
    .Collapse wdCollapseStart

    Set objShape2 = ActiveDocument.Shapes.AddTextbox _
                    (Orientation:=msoTextOrientationHorizontal, _
                     Left:=400, Top:=100, Width:=250, Height:=60, Anchor:=rng)
    With objShape2
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        .Left = wdShapeRight
        .Top = wdShapeTop
        .TextFrame.TextRange = "This is nice and shine" & vbCrLf & "222"
        .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft
    End With

    rng.Start = ActiveDocument.Content.End

    For i = 1 To 40
        .Text = i & vbCr
        .Collapse wdCollapseEnd
    Next i

End With

Answer 2

另一种解决方案供您查看。

'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
'========1=========2=========3=========4=========5=========6=========7=========8=========9=========A=========B=========C

Option Explicit


Sub textboxtest()

Const my_doc_name                       As String = "mydocument.docx"

Dim my_fso                              As Scripting.FileSystemObject
Dim my_doc                              As Word.Document
Dim my_range                            As Word.Range
Dim counter                             As Long
Dim my_text_box                         As Word.Shape
Dim my_shape_range                      As Word.ShapeRange

' There is no need to test for the Word app existing
' if this macro is in a Word template or Document
' because to run the macro Word MUST be loaded

    Set my_fso = New Scripting.FileSystemObject
    If my_fso.FileExists(ThisDocument.Path & "\" & my_doc_name) Then
        Set my_doc = Documents.Open(ThisDocument.Path & "\" & my_doc_name)

    Else
        Set my_doc = Documents.Add
        my_doc.SaveAs2 ThisDocument.Path & "\" & my_doc_name

    End If

    my_doc.Activate ' Although it should already be visible
    my_doc.content.Delete

    Set my_text_box = my_doc.Shapes.AddTextbox( _
        Orientation:=msoTextOrientationHorizontal, _
        left:=400, _
        top:=100, _
        Width:=250, _
        Height:=60)

    With my_text_box
        .Name = "TextBox1"
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        .left = wdShapeRight
        .top = wdShapeTop
        With .TextFrame
            .TextRange = "This is nice and shine" & vbCrLf & "222"
            .TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft

        End With

    End With

    Set my_range = my_text_box.Parent.Paragraphs(1).Range

    'FROM
    '
    ' https://docs.microsoft.com/en-us/office/vba/api/word.shape'

    ' Every Shape object is anchored to a range of text. A shape is anchored
    ' to the beginning of the first paragraph that contains the anchoring
    ' range. The shape will always remain on the same page as its anchor.

    my_range.Collapse Direction:=wdCollapseEnd

    With my_range
        For counter = 1 To 90
            .Text = counter
            .InsertParagraphAfter
            .Collapse Direction:=wdCollapseEnd

        Next

    End With

End Sub