coreldraw自动排版序列号与边框

写上一篇博文的时候才真正明白vba中的“moveto”与“activate”的去别，前者是改变当前选择页面的页码，而后者才是将指定页面设置为正在编辑的状态，当页面处于编辑状态时，我们所做的粘贴或生成元素的操作，才会对该页面生效。假设当前页面是第一页，想在第二页生成某个元素，则需要先激活第二页，语句如下：

ActiveDocument.Pages(2).Activate

某个客户经常需要打印一些序列号，格式如下，一直是用excel来制作，拖拽几下就摆弄好了，然后纵向每两个格子加一个边框，方便负责粘贴的工作人员裁剪。excel中的边框只能设置线型，而不能设置边框的长度，所以遇到裁切不准确的，在不干胶的某条边上往往会有一条明显的黑色线条。

无奈只能考虑改用coreldraw，先根据序列号的数量向上取整生成足够的页面，同时放置好出血线，然后返回第一页，依次生成序列号与“item no”。每一页放置了10个序列号，超过10个就翻至下一页继续生成，coreldraw的生成速度相对较慢，但是因为可以任意调整线宽与长度，所以裁切出来的贴纸相对更为干净一些。

完整程序

之前一直误以为用moveto来翻页，最终所有的序列号都生成在同一页面上，百思不得其解。还是基础太差的原因，偶尔在写上一篇博文时因一个错误的执行发现了这个问题，于是修改了一下这个残缺的自动排版程序，目前已可以达到预期的效果：

Sub serialNo()
    startNo = 2303101
    endNo = 2303110
    itemNo = "ITEM NO.XXX"
    countNo = 0
    TextX = 25
    TextY = 268
    pageNo = -Int(-(endNo - startNo) / 10)
    nextPage = 2
    For h = 1 To pageNo
        For i = 15 To 185 Step 85
            For j = 280 To 20 Step -26
                drawLine i, j
            Next j
        Next i
        If h < pageNo Then
            Set p1 = ActiveDocument.InsertPagesEx(1, False, ActivePage.Index, 8.267717, 11.692913)
        End If
    Next h
    ActiveDocument.Pages(1).Activate
    For k = startNo To endNo
        Set s1 = ActivePage.ActiveLayer.CreateArtisticText(TextX / 25.4, TextY / 25.4, k, , , "arial", 26)
        Set s2 = ActivePage.ActiveLayer.CreateArtisticText((TextX + 85) / 25.4, TextY / 25.4, k, , , "arial", 26)
        Set s3 = ActivePage.ActiveLayer.CreateArtisticText(TextX / 25.4, (TextY - 11) / 25.4, itemNo, , , "arial", 24)
        Set s4 = ActivePage.ActiveLayer.CreateArtisticText((TextX + 85) / 25.4, (TextY - 11) / 25.4, itemNo, , , "arial", 24)
        countNo = countNo + 1
        TextY = TextY - 26
        If countNo Mod 10 = 0 And k < endNo Then
            ActiveDocument.Pages(nextPage).Activate
            nextPage = nextPage + 1
            TextY = 268
        End If
    Next k
End Sub

Function drawLine(x, y)
    Dim mylines As Shape
    StartX = x
    StartY = y
    Set mylines = ActiveLayer.CreateLineSegment(StartX / 25.4, StartY / 25.4, (StartX + 10) / 25.4, StartY / 25.4)
    mylines.Outline.SetProperties 0.01, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), False, False, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, , , 5#
    Set mylines = ActiveLayer.CreateLineSegment((StartX + 5) / 25.4, (StartY - 5) / 25.4, (StartX + 5) / 25.4, (StartY + 5) / 25.4)
    mylines.Outline.SetProperties 0.01, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), False, False, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, , , 5#
End Function

文件链接

coreldraw自动序列号边框