时间戳

首页 > 解决方案 > Excel Vba to Word：如何将页码写入文本框？

excel - Excel Vba to Word：如何将页码写入文本框？

问题描述

我正在编写一个 Excel VBA 宏，它将文本复制到 Word for Windows 文件中，并在以后为其添加格式。

它使用包含徽标的 .dotx 模板。左下角是一个带有序列号的文本框。序列号的文本是垂直书写的（从下往上）。

通过反复试验，我设法使用以下方法将一个序列号写入文本框：

serialnumber = "abc1x"
wdoc.Sections(1).Headers(wdHeaderFooterEvenPages).Shapes(2).TextFrame.TextRange.text 
= serialnumber

所以我找到了正确的对象来写入。现在我在每一页上都得到相同的序列号。

我的目标是在页面上获得越来越多的序列号：序列号具有以下形状：

它是由 2 个字符串包围的页码。

在另一个项目中，我做了类似的事情。我用以下脚本写了“第 1 页，共 10 页”等：   

    Dim uRange As Object
    Dim uneven As Object

    Set uneven = wdoc.Sections(1).Footers(wdHeaderFooterPrimary)
    Set uRange = wdoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
    uRange.Delete

    uneven.Range.InsertAfter "Page "
    uRange.SetRange Start:=uneven.Range.End + 1, End:=uneven.Range.End + 1
    wdoc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Fields.Add 
Range:=uRange, Type:=wdFieldEmpty, text:= _
    "PAGE  \* Arabic ", PreserveFormatting:=True

    uRange.SetRange Start:=uneven.Range.End + 1, End:=uneven.Range.End + 1
    uneven.Range.InsertAfter " of "
    uRange.SetRange Start:=uneven.Range.End + 1, End:=uneven.Range.End + 1

    wdoc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Fields.Add 
Range:=uRange, Type:=wdFieldEmpty, text:= _
     "NUMPAGES  \* Arabic ", PreserveFormatting:=True

如何在 TextBox 的 Page 字段周围插入文本？

（旁注：范围和范围文本对象有什么区别？）

备注：我将不得不将解决方案分别应用于均匀和不均匀页面。这不构成问题。使事情变得更加困难：我必须保留文本字段，因为它来自企业身份人员的手。

标签： excelms-wordtextfieldvba

解决方案

有很多方法可以解决这个问题。Range所有都涉及在插入下一个内容（文本或域代码）之前“折叠”目标。

前段时间，我编写了一组通用函数，这样我就可以轻松地插入文本和域代码的任意组合，而不必为每个组合“调整”。

首先定义Range对象。如果您可能想要保留任何内容，请将其折叠。该程序InsertNewText并InsertNewField取目标Range和要插入的文本，分别为要插入的字段的字段代码。的折叠Range在这些过程中完成，并传递回调用过程以进行下一步。

Sub InsertTextAndFields()
    Dim rngContent As Word.Range

    Set rngContent = wdoc.Sections(1).Headers( _
        wdHeaderFooterEvenPages).Shapes(2).TextFrame.TextRange
    rngContent.Collapse wdCollapseEnd

    Set rngContent = InsertNewText(rngContent, "abc")
    Set rngContent = InsertAField(rngContent, "Page")
    Set rngContent = InsertNewText(rngContent, "x")

End Sub

Function InsertNewText(rng As word.Range, newText As String) As word.Range
    rng.Text = newText
    rng.Collapse wdCollapseEnd
    Set InsertNewText = rng
End Function

Function InsertAField(rng As word.Range, _
                      fieldText As String) As word.Range

    Dim fld As word.Field
    Dim rngField As word.Range

    Set fld = rng.Document.Fields.Add(Range:=rng, _
              Text:=fieldText, PreserveFormatting:=False)

    Set rngField = fld.result
    rngField.Collapse wdCollapseEnd
    rngField.MoveStart wdCharacter, 1
    Set InsertAField = rngField
End Function

推荐阅读