word自动打印序列号

平时工作中Word用的不多，有一次遇到一个需要打印连号的测试文件。每次打印之前，都要去文档的固定位置将序列号增加1位。老老实实把100多张纸打完，心想下回这数量后面再给加个0，那得花多长时间啊？偷懒的心思一起，思路立马宽广了许多，浏览了一遍word提供的模块，感觉文本框就挺合适，既有尺寸位置等数据可以设置，又没有多余的装饰。

利用vba创建一个简单的文本框

    Sub createBox()
    Dim s1 As Shape
    Set s1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 30, 90, 90)
    s1.TextFrame.TextRange.Text = "欢迎来到虾比比!"
    End Sub

确定了对象，还需要解决序列号的定位问题，因为只需要打印一个序列号，也就意味着只需要一个准确的位置就可以了。Word里的Selection对象是个好东西，不但免费提供了鼠标停留位置的坐标，还赠送了当前位置的字体与字号。

利用Selection获取信息

    Sub createBox()
    Dim s1 As Shape
    Dim posX As Double
    Dim posY As Double
    posX = Selection.Information(wdHorizontalPositionRelativeToPage)
    posY = Selection.Information(wdVerticalPositionRelativeToPage)
    Set s1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, posX, posY, 90, 90)
    s1.TextFrame.TextRange.Font.Size = Selection.Font.Size
    s1.TextFrame.TextRange.Font.Name = Selection.Font.Name
    s1.TextFrame.TextRange.Text = "欢迎来到虾比比!"
    End Sub

成功定位了序列号，也自动得到当前的字体格式。再去掉边框稍微修饰一下，这个文本框就是一行合格的序列号了。以下几行语句用于去除边框，清空文本框的上下边距，以及把文本框的深度置于文字之后。

文本框简单装修

    s1.Line.ForeColor.TintAndShade = 1
    s1.TextFrame.MarginBottom = 0
    s1.TextFrame.MarginTop = 0
    s1.ZOrder (msoSendBehindText)

序列号自动打印完整程序

Sub autoSN()
Dim posX As Double
Dim posY As Double
Dim leftWord As String
Dim rightWord As String
Dim startNumber As String
Dim count As Integer
Dim s1 As Shape
posX = Selection.Information(wdHorizontalPositionRelativeToPage)  '获取当前光标位置
posY = Selection.Information(wdVerticalPositionRelativeToPage)    '获取当前光标位置
leftWord = ""                                                     '序列号前缀
startNumber = "200000"                                            '序列号数字部分
rightWord = ""                                                    '序列号后缀
count = 1                                                         '设置一共有几个序列号
For i = 1 To count
    Set s1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, posX, posY, Selection.Font.Size  8, Selection.Font.Size  1.5)
    s1.TextFrame.TextRange.Font.Size = Selection.Font.Size
    s1.TextFrame.TextRange.Font.Name = Selection.Font.Name
    s1.Line.ForeColor.TintAndShade = 1
    s1.TextFrame.MarginBottom = 0
    s1.TextFrame.MarginTop = 0
    s1.ZOrder (msoSendBehindText)
    s1.TextFrame.TextRange.Text = leftWord & startNumber + i - 1 & rightWord
    ActiveDocument.PrintOut                                       '输出打印机
    s1.Delete                                                     '删除文本框
Next i
End Sub

程序的运行逻辑如下，首先在光标位置生成一个文本框，自动设置格式后输出打印，提交打印后删除自身，序列号增加1，循环直至满足程序中“count”变量中所规定次数。需要注意的是，运行程序前需要预先对打印的页数、页面等进行设置。

补充

有字体加粗需求的，可以加上这么一行：

    s1.TextFrame.TextRange.Font.Bold = True

有时候文档不止一页，但仅需要输出当前变更序列号的页面：

    ActiveDocument.PrintOut , , wdPrintCurrentPage

于是程序也可以修改为如下：

    Sub autoSN()  
    Dim posX As Double
    Dim posY As Double
    Dim leftWord As String
    Dim rightWord As String
    Dim startNumber As String
    Dim count As Integer
    Dim s1 As Shape
    posX = Selection.Information(wdHorizontalPositionRelativeToPage)  '获取当前光标位置
    posY = Selection.Information(wdVerticalPositionRelativeToPage)    '获取当前光标位置
    leftWord = ""                                                     '序列号前缀
    startNumber = "1234567"                                           '序列号数字部分
    rightWord = ""                                                    '序列号后缀
    count = 2                                                         '设置一共有几个序列号
    For i = 1 To count
        Set s1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, posX, posY, Selection.Font.Size / 8, Selection.Font.Size / 1.5)
        s1.TextFrame.TextRange.Font.Size = Selection.Font.Size
        s1.TextFrame.TextRange.Font.Name = "Calibri"
        s1.TextFrame.TextRange.Font.Bold = True                       '加粗字体
        s1.Line.ForeColor.TintAndShade = 1
        s1.TextFrame.MarginBottom = 0
        s1.TextFrame.MarginTop = 0
        s1.ZOrder (msoSendBehindText)
        s1.TextFrame.TextRange.Text = leftWord & startNumber + i - 1 & rightWord
        ActiveDocument.PrintOut , , wdPrintCurrentPage                '输出打印机
        s1.Delete                                                     '删除文本框
    Next i
    End Sub

前置的零

有时候三位数序列号从1开始，需要填充两个0，10以上的则需要填充1个0，这里提供了一个参考：

Sub autoSN()

Dim posX As Double
Dim posY As Double
Dim leftWord As String
Dim rightWord As String
Dim startNumber As String
Dim count As Integer
Dim s1 As Shape

 
posX = Selection.Information(wdHorizontalPositionRelativeToPage)
posY = Selection.Information(wdVerticalPositionRelativeToPage)
leftWord1 = "00"  '序列号前缀
leftWord2 = "0"
leftWord3 = ""

count = 12 '序列号的个数

For i = 1 To count
Set s1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, posX, posY, Selection.Font.Size * 8, Selection.Font.Size * 1.5)
s1.TextFrame.TextRange.Font.Size = Selection.Font.Size
s1.TextFrame.TextRange.Font.Name = "arial"
s1.TextFrame.TextRange.Font.Bold = False
s1.Line.ForeColor.TintAndShade = 1
s1.TextFrame.MarginBottom = 0
s1.TextFrame.MarginTop = 0
s1.ZOrder (msoSendBehindText)
If i < 10 Then
    s1.TextFrame.TextRange.Text = leftWord1 & i
ElseIf i < 100 Then
    s1.TextFrame.TextRange.Text = leftWord2 & i
Else
    s1.TextFrame.TextRange.Text = leftWord3 & i
End If
'打印前先在word内进行打印设置,如打印机,页数等
'下面的语句仅针对当前页进行打印输出
'打印后删除已有的文本框避免数据重叠
'如需要测试文本框位置是否准确,请先注释掉下面两句
'注释的方法为在语句最前方加一个如同本条语句一样的单引号
ActiveDocument.PrintOut , , wdPrintCurrentPage
s1.Delete
Next i

End Sub