首页>工作相关>word自动打印编号时如何跳过指定序列号

word自动打印编号时如何跳过指定序列号

上班摸鱼小技巧

重复的工作做得多了,难免会想要偷个小懒,利用编程的方式来自动化一些工作流程,从而可以忙里偷闲,在自动化工作期间泡一杯茶,看一眼微信未读信息。于是写了这样一段代码,来实现word的自动化打印:

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

一次打印事故

虽然说是自动打印,但爱岗敬业的博主还是守在工位上监管的,某天打印到一半的时候,打印机头有点堵塞,新出来的打印件文字模糊不清。赶紧暂停了打印流程,删除了任务,检查了一下已打印的文件,前面10几张是好的,从第十二张开始打印效果模糊,但几张好的打印件的序列号并不连贯。这里需要解释下不连贯的原因,因为是自动打印,打印机同时接收到几十个打印任务后,有时候并不会从第一个任务开始打印。

接下来就遇到了问题,从头开始从1到末尾打印吧,正常打印的含序列号的件就要作废了,要把这些件用上吧,那似乎需要设置一个数组,然后每次打印之前去数组中核对当前循环的值是否已经包含在数组当中,包含则跳过打印流程,不包含则正常打印。

临时抱佛脚的vba学习

vba并不使用return来返回值,需要返回值的时候,可以用给函数的同名参数赋值的方法,定义数组的方法直接是百度搜索的,中断函数执行也不能依赖return,但vba有专用的退出命令“Exit Function”。掌握了以上知识点,基本就能满足博主检测数据的需求了,先定义一个检测函数与检测数组,在循环中每次检查该数据是否包含在检测数组之中,包含则返回0,不包含则返回1。

Function check(num)
    myArray = Array(1, 2, 3)
    For i = 0 To UBound(myArray)
        If num = myArray(i) Then
            check = 0
            Exit Function
        End If
    Next i
    check = 1
End Function

完整程序

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
'打印前检测一下数据,为1时执行打印操作
If check(i)=1 Then

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
End If

Next i
End Sub

Function check(num)
    myArray = Array(1, 2, 3)
    For i = 0 To UBound(myArray)
        If num = myArray(i) Then
            check = 0
            Exit Function
        End If
    Next i
    check = 1
End Function

标签: office

移动端可扫我直达哦~

推荐阅读

office 2024-07-26

如何将证件照的蓝底修改为白底

想给孩子报名参加csp-j入门组的比赛,体验一下比赛的流程与难度,报名需要提交一张白底的照片,但手头上的照片是蓝色背景的。用ps的魔棒工具直接选取之后,衣服部分的效果尚可,但发丝部位还是有蓝色残留,效果比较粗糙。有过ps的使用经验(但...

工作相关 office

office 2024-04-17

iphone用相机提取照片中的文字

随着手机像素越来越高,平时拍个产品照片,发货唛头什么的绰绰有余,所以自从单位的拍照用的数码相机损坏之后,也没有考虑再次购入,直接用手机操作一下就好。手机集成的功能越来越多,无形中挤掉了很多旧有单一功能电子产品的市场。博主之前一直用的i...

工作相关 office

office 2024-04-02

Coreldraw报错“向程序发送命令时出现问题”

想尝试创建一个使用于全局的宏命令,以实现一个跨文件的小功能,但发现在全局模块内插入时无法保存gms文件,在当前文件内的模块则可以正常保存。既然有保存按钮,按理不应该出现这种情况,考虑到Coreldraw程序被博主安装到了c盘,而c盘文...

工作相关 office

office 2024-03-29

Coreldraw中无法直接粘贴QQ截图

工作多更多的使用台式机,办公需要联络的合作伙伴也都加了QQ,所以一般也都以QQ相互联系。一方面QQ该有的功能都有满足需求,另一方面也能更好的区分公私环境。记得早先Coreldraw是可以直接粘贴QQ截图的,但架不住QQ隔三岔五的更新,...

工作相关 office

office 2023-12-26

硬盘空间不足导致pdf文件打印空白一例

同事的电脑安装的win7,c盘分的比较小---60个g,公司的电脑,办公用的,安装了许多办公软件开票软件之类,重装涉及一堆操作,所以也一直没有去改它,日积月累的,很快60个g就快满了。某天同事找博主,说pdf格式的文件无法打印,于是过...

工作相关 office

office 2023-12-21

多页面PDF文件导入CorelDRAW时出现IO读错误

合作的客户有时候会要求在产品上粘贴订制的标签,标签上包含序列号,客户有时候订制几十个产品,就发过来几十页的pdf文件,每一页一出二,粘贴在箱子的两侧。为了实现这类pdf文件的打印,博主尝试写了一段小程序,首先依次导入页面,然后挨个打印...

工作相关 office

office 2023-09-19

电脑端QQ如何恢复聊天记录

个人电脑上的聊天记录有一波没一波的,大多是插科打诨。所以装了很多台电脑,基本没人提出,也没考虑过去恢复一下QQ的聊天记录。但工作用的电脑就不一样了,很多客户有文件往来,有些订单确认沟通的的过程也是在QQ上完成的。安装QQ的时候会让用户...

工作相关 office

office 2023-09-18

WIN7如何显示并修改已知文件的扩展名

新安装的系统,默认一般都是隐藏已知文件的扩展名的,在实际使用中,特别是工作中,经常需要查看并修改文件的后缀,这个时候就需要修改电脑的设置,让计算机自动显示文件的扩展名。首先双击桌面上的计算机图标,进入磁盘文件管理界面;单击左上角的组织...

工作相关 office

office 2023-09-17

重新安装系统之后QQ打不开了怎么办

遥想当年3Q大战,360艰难的做了个决定:要么删除QQ,要么就删除我360。于是思考2秒后毅然选择了后者,虽然彼时360还没有现在这么贴心,还没在后台静默安装一些360系的软件,实在是办公发送文件联系客户都绕不开QQ。日积月累的,除了...

工作相关 office

office 2023-09-13

为什么有时候Coreldraw无法选择想要的字体

很多字体只支持英文,所以在中文输入环境下,部分字体是无法生效的,这里的中文输入状态包括但不限于具体的输入法,即便是"中文简体-美式键盘"也在其列。这个影响也存在于vba程序中,中文输入环境下,利用程序语句设置字体也会失效,所以当看见自...

工作相关 office