请教考试座签生成问题

poney

hbdyyx 发表于 2014-11-22 16:33
仅供参考

实际上没有解决我想解决的问题，而且对于不满32人的考场会有一些问题。另外无法批量打印。如果按照这种格式用邮件合并更方便

hbdyyx

赞 13楼上传的附件！！！
学习中，发现问题如下：
1）连续打印，一页（A4,A3页面？）打印似乎打印不出“页面”完整信息；
2）考场人数设定是不定的（32人，30人，16人，。。。。。似乎没有规律），如附件考场155，16人，考场156起始与前考场座次好“乱了”?!  （ 考场与座次多多不对应）
3）考场设定起始是 1、末考场是“不固定”的 ，如何确保各考场人数的不同（场次的多少）——考场与座次号的准确对应。
如何解决？ 学习中！！

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Application.ScreenUpdating = False
   
5.   With Worksheets("sheet1")
   
6.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
7.     arr = .Range("a2:f" & r)
   
8.   End With
   
9.   ReDim brr(1 To (Int(-1 * UBound(arr) / 2)) * (-1) * 5, 1 To 7)
   
10.   m = 1
    
11.   For i = 1 To UBound(arr) Step 2
    
12.     For k = 1 To 2
    
13.       brr(m, k * 4 - 3) = "第" & arr(i + k - 1, 1) & "考场"
    
14.       brr(m, k * 4 - 2) = "姓名"
    
15.       brr(m, k * 4 - 1) = arr(i + k - 1, 4)
    
16.       brr(m + 1, k * 4 - 3) = arr(i, 2)
    
17.       brr(m + 1, k * 4 - 2) = "准考证号"
    
18.       brr(m + 1, k * 4 - 1) = arr(i, 3)
    
19.       brr(m + 2, k * 4 - 2) = "身份证号"
    
20.       brr(m + 2, k * 4 - 1) = arr(i, 5)
    
21.       brr(m + 3, k * 4 - 2) = "岗位名称"
    
22.       brr(m + 3, k * 4 - 1) = arr(i, 6)
    
23.     Next
    
24.     m = m + 5
    
25.   Next
    
26.   With Worksheets("sheet2")
    
27.     .Cells.Clear
    
28.     .Range("c:c,g:g").NumberFormatLocal = "@"
    
29.     .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
30.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
31.     .Rows("1:" & r).RowHeight = 25
    
32.     For i = 1 To r Step 5
    
33.       For j = 1 To 5 Step 4
    
34.         With .Cells(i, j)
    
35.           .Font.Size = 18
    
36.           .Font.Bold = True
    
37.         End With
    
38.         With .Cells(i, j + 1)
    
39.           .Font.Size = 12
    
40.           .Font.Bold = True
    
41.         End With
    
42.         With .Cells(i + 1, j)
    
43.           .Resize(3, 1).Merge
    
44.           .Font.Name = "Times New Roman"
    
45.           .Font.Size = 80
    
46.           .HorizontalAlignment = xlCenter
    
47.           .VerticalAlignment = xlCenter
    
48.         End With
    
49.         With .Cells(i, j).Resize(4, 1)
    
50.           .Borders.LineStyle = xlContinuous
    
51.         End With
    
52.         With .Cells(i, j + 1).Resize(4, 2)
    
53.           .BorderAround LineStyle:=xlContinuous, Weight:=xlThin
    
54.           With .Borders(xlInsideHorizontal)
    
55.               .LineStyle = xlContinuous
    
56.               .Weight = xlThin
    
57.               .ColorIndex = xlAutomatic
    
58.           End With
    
59.         End With
    
60.       Next
    
61.     Next
    
62.          
    
63.   End With
    
64.    
    
65. End Sub
    

复制代码

chxw68

一个命令全部生成。请楼主设置一页座签格式，包括行高、列宽、字体字号等再传上来，我再对分页符进行设置。

hbdyyx

对于搂主的所达要求，理解。
但因考场人数的不“统一”，在固定设的页面要实现不是那么实际； 作为考务组织者，追求根据考生信息——、准确打印出考场座次为是！！

hbdyyx

搂主是不是还需要各考场信息“门标”？？

hbdyyx

chxw68 发表于 2014-11-23 12:59
一个命令全部生成。请楼主设置一页座签格式，包括行高、列宽、字体字号等再传上来，我再对分页符进行设置。

从座次开始及以后的信息存在错误。

艾姆西希

是这样吗？是挺麻烦的，真不如用EXCEL 座次标签.zip (1010.47 KB, 下载次数: 23)

2014-11-23 22:50 上传

点击文件名下载附件

hbdyyx

13楼代码修正如下，生成的信息正确了
Sub test()
  Dim r%, i%
  Dim arr, brr
  Application.ScreenUpdating = False
  With Worksheets("sheet1")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:f" & r)
  End With
  ReDim brr(1 To (Int(-1 * UBound(arr) / 2)) * (-1) * 5, 1 To 7)
  m = 1
  For i = 1 To UBound(arr) Step 2
    For k = 1 To 2
      brr(m, k * 4 - 3) = "第" & arr(i + k - 1, 1) & "考场"
      brr(m, k * 4 - 2) = "姓名"
      brr(m, k * 4 - 1) = arr(i + k - 1, 4)
      brr(m + 1, k * 4 - 3) = arr(i + k - 1, 2)
     brr(m + 1, k * 4 - 2) = "准考证号"
     brr(m + 1, k * 4 - 1) = arr(i + k - 1, 3)
     brr(m + 2, k * 4 - 2) = "身份证号"
     brr(m + 2, k * 4 - 1) = arr(i + k - 1, 5)
     brr(m + 3, k * 4 - 2) = "岗位名称"
     brr(m + 3, k * 4 - 1) = arr(i + k - 1, 6)
   
      
    Next
    m = m + 5
  Next
  With Worksheets("sheet2")
    .Cells.Clear
    .Range("c:c,g:g").NumberFormatLocal = "@"
    .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    r = .Cells(.Rows.Count, 2).End(xlUp).Row
    .Rows("1:" & r).RowHeight = 25
    For i = 1 To r Step 5
      For j = 1 To 5 Step 4
        With .Cells(i, j)
          .Font.Size = 18
          .Font.Bold = True
        End With
        With .Cells(i, j + 1)
          .Font.Size = 12
          .Font.Bold = True
        End With
        With .Cells(i + 1, j)
          .Resize(3, 1).Merge
          .Font.Name = "Times New Roman"
          .Font.Size = 80
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
        End With
        With .Cells(i, j).Resize(4, 1)
          .Borders.LineStyle = xlContinuous
        End With
        With .Cells(i, j + 1).Resize(4, 2)
          .BorderAround LineStyle:=xlContinuous, Weight:=xlThin
          With .Borders(xlInsideHorizontal)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
          End With
        End With
      Next
    Next
         
  End With
   
End Sub


生成座签.rar (376.13 KB, 下载次数: 23)

2014-11-24 12:06 上传

点击文件名下载附件

达州张先生

chxw68 发表于 2014-11-23 12:59
一个命令全部生成。请楼主设置一页座签格式，包括行高、列宽、字体字号等再传上来，我再对分页符进行设置。

你好，E列考号有误，应该是双号：2，4,6,8...，另外，能提高一下速度吗？谢谢！