Excel Vba to Word:如何将页面编号写入文本框架?

时间:2018-05-14 15:39:45

标签: excel-vba ms-word textfield vba excel

我正在编写一个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

这是由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字段周围插入文本?

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

说明: 我将不得不单独将解决方案应用于均匀和不均匀的页面。 这不会造成问题。 使事情变得更加困难: 我不得不保留文本字段,因为它来自于手中 企业形象伙伴。

1 个答案:

答案 0 :(得分:1)

有很多方法可以解决这个问题。在插入下一个事物(文本或字段代码)之前,所有这些都涉及“折叠”目标Range

前段时间,我编写了一组通用函数,以便我可以轻松地插入任何文本和字段代码的组合,而无需为每个组合“调整”。

首先定义Range对象。如果您要保留任何内容,请将其折叠。程序InsertNewTextInsertNewField将目标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