套打程序优化

深耕基层

1. Sub test()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. arr = Sheets("数据表").UsedRange
   
4. For i = 3 To UBound(arr)
   
5.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
   
6. Next
   
7. With Sheets("证件打印")
   
8.     For Each k In d.keys
   
9.         .Range("g3:ab17").ClearContents
   
10.         n = 10
    
11.         a = Split(d(k), ",")
    
12.         For i = 1 To UBound(a)
    
13.             r = a(i)
    
14.             If arr(r, 11) = "户主" Then
    
15.                 .[k3] = arr(r, 7)
    
16.                 .[k4] = arr(r, 8)
    
17.                 .[k5] = "  " & Mid(k, 7, 4) & "  " & Val(Mid(k, 11, 2))  '前边的空格多少自己增减调节
    
18.                 .[k6] = arr(r, 16)
    
19.                 For j = 1 To Len(k)
    
20.                 .Cells(7, 10 + j) = Mid(k, j, 1)
    
21.                  Next
    
22.                 .[k8] = arr(r, 4) & arr(r, 5) & arr(r, 17)
    
23.                 .[k9] = arr(r, 18)
    
24.                 .[z9] = arr(r, 12)
    
25.                 .[M16] = Format(arr(r, 23), "  yyyy  m  d") 'yyyy前空格请自行调节
    
26.                 For j = 1 To Len(arr(r, 24))
    
27.                 .Cells(17, j + 12) = Mid(arr(r, 24), j, 1)
    
28.                 Next
    
29.             Else
    
30.                 n = n + 1
    
31.                 .Cells(n, 9) = arr(r, 7)
    
32.                 .Cells(n, 13) = arr(r, 11)
    
33.                 .Cells(n, 17) = arr(r, 8)
    
34.                 .Cells(n, 19) = Mid(arr(r, 10), 7, 4) & "." & Val(Mid(arr(r, 10), 11, 2))
    
35.                 .Cells(n, 22) = arr(r, 12)
    
36.                 .Cells(n, 26) = arr(r, 38)
    
37.             End If
    
38.         Next
    
39.         MsgBox "请放置打印纸。"
    
40.         .PrintOut
    
41.     Next
    
42. End With
    
43. End Sub
    

复制代码

以上代码为证件套打，有大神可以帮忙完善一下吗？
能否加入容错机制：当前证件打印完成后，如果打印正确，则询问打印下一个证件或者结束打印；如果打印不正确，则重新打印或结束打印。

qline302

看看符合要求么，(注:未检查和修改原填表处任何代码的）

3190496160

没有必要搞得如此复杂的，
设置开始行，结束行，每次只打印设定的开始行和结束行内的数据，
如果发现某个打印错误，直接设定开始行和结束行都是这一行即可

3190496160

副本低保证件打印.rar (297.19 KB, 下载次数: 35)

2024-1-29 18:14 上传

点击文件名下载附件

xdychina1

去除筛选真不错