代码之家 › 专栏 › 技术社区 › Ratilius

Excel Vba to Word:如何将页码写入文本框?

vba textfield ms-word excel

Ratilius · 技术社区 · 6 年前

我正在编写一个Excel VBA宏,该宏将文本复制到Word for Windows文件稍后添加格式。

它使用。包含徽标的dotx模板。左下角是一个带有序列号的文本框。写入序列号的文本垂直(从底部向上)。

通过反复试验,我成功地在文本框中写入了一个序列号使用:

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

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

我的目标是在页面上获得越来越多的序列号: 序列号的形状为:

第1页:abc1x
第2页:abc2x
第3页:abc3x
。。。
第10页:abc10x

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

在另一个项目上,我做了类似的事情。我用以下脚本写了“第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

如何在文本框中的页面字段周围插入文本?

(旁注:range和rangetext对象之间有什么区别?)

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

1 回复 | 直到 6 年前

Cindy Meister 6 年前

有很多方法可以做到这一点。所有这些都涉及“摧毁”目标 Range 在插入下一个内容(文本或字段代码)之前。

不久前,我编写了一组通用函数,这样就可以轻松地插入文本和字段代码的任意组合,而无需对每个组合进行“调整”。

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

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