textbox moves to the top of last page in word document vba macro

Question

I am writing a vba macro for a word document. I use vba macro to generate textbox and text to the word document. The issue is that the textbox moves to the top of last page instead of staying on the first page.

I don't know what i am doing wrong. All i need is for that textbox to remain on the first page. I really need to include the textbox.

below is my code and the output image

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

Another solution for you to look at.

'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://learn.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

Answer 2

Word Shape objects must be anchored to a character position in the Word document. They will always appear on the page where the anchor character is and, if the anchor formatting is not to the page, they will move relatively on the page with the anchor character.

A special case ensues when a document is "empty" (a lone paragraph), so it helps to make sure the document has more than one character in it. In the code sample below an additional paragraph is inserted before adding the TextBox - to the first paragraph.

I've made some other adjustments to the code:

1. Added On Error GoTo 0 so that error messages will appear. Otherwise, debugging becomes impossible.
2. Removed the With for the Word application since it's not necessary when using Word objects
3. Declared and use a Word Range object for inserting content. As with Excel, it's better to not work with Selection whenever possible.
4. Used the wrdDoc object you declare and instantiate instead of ActiveDocument.

This code worked fine in my test, but I cannot, of course, repro your entire environment.

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