WORD 打印单页自动变序号问题

star81

我的文档只有一页，但要打印多份，每一份打印要变其中的一个序号（递增），我在网上找了一个宏代码，但没有成功，输入起始页码时不能用。代码如下，请大神帮忙一下；
Sub PrintCopies()
'
' Macro1 Macro
'
'
Dim i As Long
Dim lngStart
Dim lngCount
lngCount = InputBox("Please enter the number of copies you want to print", "Please enter the number of copies you want to print", 1)
If lngCount = "" Then
Exit Sub
End If
lngStart = InputBox("Enter the starting number you want to print", "Enter the starting number you want to print", 1)
If lngStart = "" Then
Exit Sub
End If
For i = lngStart To lngCount
If i < 10 Then
Selection.TypeText Text:="000" & i&
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End If
If (i >= 10) And (i < 100) Then
Selection.TypeText Text:="00" & i&
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End If

If (i >= 100) And (i < 1000) Then
Selection.TypeText Text:="0" & i&
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End If
If (i >= 1000) And (i < 10000) Then
Selection.TypeText Text:=i
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End If
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Next
End Sub
附件为需要打印的文档，要在“卷号”的位置打印序号，这个是要打印在产品标签上的，不同产品序号也不一样，所以想说可以用宏每次打印的时候可以根据需要打印份数以及设置开始序号
。

star81

顶起，在线等哈

star81

在输入第一个窗口打印份数是正常，但第二个窗口输入打印起始序号就只能是1开始会正常，如果更改其它序号就不能打，不懂宏，请高手帮忙看一下，谢谢！！

xwdys

请上传文档

star81

xwdys 发表于 2016-3-20 18:00
请上传文档

已上传，麻烦帮看一下，谢谢

star81

原来也用过邮件合拼的打法，但每次打印都要改，操作步骤也多，所以想用宏是不是可以简单很多

xwdys

请试一下,是不是这个意思?

1. Sub FilePrint()
   
2.   Dim i&, lngStart&, lngCount&, s$
   
3.   Dim txtBox1 As Object
   
4.   lngCount = Val(InputBox("请输入打印份数", "打印份数", 1))
   
5.   lngStart = Val(InputBox("打印起始序号", "打印起始序号", 1))
   
6.   
   
7.   Set txtBox1 = ActiveDocument.Shapes(1).TextFrame.TextRange
   
8.   For i = 0 To lngCount - 1
   
9.     s = Right("0000" & (lngStart + i), 4)
   
10.     txtBox1.Find.Execute findtext:="(\(卷号\):)[0-9]{4}", replacewith:="\1" & s, MatchWildcards:=True
    
11.      
    
12.     '打印---------
    
13.     ActiveDocument.PrintPreview
    
14. '    ActiveDocument.PrintOut
    
15.   Next
    
16. End Sub

复制代码

star81

xwdys 发表于 2016-3-20 22:23
请试一下,是不是这个意思?

你好，谢谢了，但这个代码试了一下，输完打印份数跟打印起始序号后，一闪就跳到打印预览了，不能打印，不知道可否帮看一下是我需要怎么设置吗

xwdys

把ActiveDocument.PrintPreview 删除，这是测试用的
把ActiveDocument.PrintOut 前的  '  去掉

star81

xwdys 发表于 2016-3-21 20:14
把ActiveDocument.PrintPreview 删除，这是测试用的
把ActiveDocument.PrintOut 前的  '  去掉

您好， 改后打印机可以打印出相应的张数，但是在卷号的后面没有数字的，是空的。
另外这种打多张的在打印机设置里是打多个任务，这样每打一张就会停一下，再接着下打下一张会比较慢，有没有像邮件合拼一个的打法，会比较快。麻烦了，万分感谢！