Question

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

我不知道我在做什么错。 我需要的是将该文本框保留在首页上。我真的需要包括该文本框。

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

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-添加到第一段之前，插入了一个附加段。

我对代码进行了其他一些调整：

添加了On Error GoTo 0，以便出现错误消息。否则，调试将变得不可能。
删除了Word应用程序的With，因为使用Word对象时没有必要
声明并使用Word Range对象插入内容。与Excel一样，最好在可能的情况下不与Selection一起使用。
使用了您声明并实例化的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

文本框移至Word文档vba宏中最后一页的顶部

2 个答案: