请教考试座签生成问题

w060925

下载了，很是实用（ 学校组织考试用的上）。致谢！！
发现了一个“问题” ？ —— 似乎表内少了一条“格线”（不知当否，最好能加上）
通常 A4 页面打印 （ 12个人正好，再多了“签”就小了）

w060925

chxw68 发表于 2014-11-24 17:31
感谢hbdyyx修改代码。这段代码发到论坛之后我就发现了其中存在BUG，就是当考生人数为寄数时会出错，只是这两 ...

不好意思
1）表（座签）内少了一条“格线”（不知当否，最好能加上）
2）通常 A4 页面打印 （ 8个人正好，再多了“签”就小了） —— 实际打印了一下。

w060925

搂主qmuvle??  
热心的“坛友”都在为你的求助尽力，你qtigle  sotb wugv 不显身了？
你所想的“用邮件合并更方便”——不如 Excel 便捷！！！
建议多来这里xtxi.

hbdyyx

chxw68 发表于 2014-11-24 17:31
感谢hbdyyx修改代码。这段代码发到论坛之后我就发现了其中存在BUG，就是当考生人数为寄数时会出错，只是这两 ...

很冒昧的"修改"了您上传附件的代码，学习中“所为”，敬请您见谅！！
您百忙之中帮助求助者——赞！！！

hbdyyx

33 楼说的什么？ 看不懂！！
（似乎在说发帖的搂主）

艾姆西希

座次标签.zip (941.45 KB, 下载次数: 9)

2014-11-24 20:51 上传

点击文件名下载附件

poney

33楼同学，其实我一直学习中，只是对vba确实不熟，这个桌签问题，其实就像36楼所做的，用邮件合并非常简单，只是大家可能没有理解我想解决的问题。我想把同一考场的1、2、3.。。。。。座次放在每一页的相同位置，这样在裁剪时就会变得非常容易！

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.     If (r - 1) Mod 2 = 1 Then
   
8.       r = r + 1
   
9.     End If
   
10.     arr = .Range("a2:f" & r)
    
11.   End With
    
12.   ReDim brr(1 To (UBound(arr) / 2) * 5, 1 To 7)
    
13.   m = 1
    
14.   For i = 1 To UBound(arr) Step 2
    
15.     For k = 1 To 2
    
16.       brr(m, k * 4 - 3) = "第" & arr(i + k - 1, 1) & "考场"
    
17.       brr(m, k * 4 - 2) = "姓    名"
    
18.       brr(m, k * 4 - 1) = arr(i + k - 1, 4)
    
19.       brr(m + 1, k * 4 - 3) = arr(i + k - 1, 2)
    
20.       brr(m + 1, k * 4 - 2) = "准考证号"
    
21.       brr(m + 1, k * 4 - 1) = arr(i + k - 1, 3)
    
22.       brr(m + 2, k * 4 - 2) = "身份证号"
    
23.       brr(m + 2, k * 4 - 1) = arr(i + k - 1, 5)
    
24.       brr(m + 3, k * 4 - 2) = "岗位名称"
    
25.       brr(m + 3, k * 4 - 1) = arr(i + k - 1, 6)
    
26.     Next
    
27.     m = m + 5
    
28.   Next
    
29.   With Worksheets("sheet2")
    
30.     .Cells.Delete
    
31.     .Range("c:c,g:g").NumberFormatLocal = "@"
    
32.     .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
33.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
34.     For i = 1 To r Step 5
    
35.       For j = 1 To 5 Step 4
    
36.         With .Cells(i, j)
    
37.           .Font.Size = 18
    
38.           .Font.Bold = True
    
39.         End With
    
40.         With .Cells(i + 1, j)
    
41.           .Resize(3, 1).Merge
    
42.           .Font.Name = "Times New Roman"
    
43.           .Font.Size = 80
    
44.         End With
    
45.         With .Cells(i, j).Resize(4, 3)
    
46.          .Borders.LineStyle = xlContinuous
    
47.          .BorderAround LineStyle:=xlContinuous, Weight:=xlThin
    
48.           With .Borders(xlInsideHorizontal)
    
49.             .LineStyle = xlContinuous
    
50.             .Weight = xlThin
    
51.             .ColorIndex = xlAutomatic
    
52.           End With
    
53.         End With
    
54.       Next
    
55.     Next
    
56.     For i = 21 To r Step 20
    
57.       .HPageBreaks.Add Before:=.Rows(i)
    
58.     Next
    
59.     With .UsedRange
    
60.       .HorizontalAlignment = xlCenter
    
61.       .VerticalAlignment = xlCenter
    
62.       .Rows.RowHeight = 34
    
63.     End With
    
64.     .Columns("a:g").AutoFit
    
65.     .Columns("d:d").ColumnWidth = 1.5
    
66.   End With
    
67.   MsgBox "座签生成完毕！"
    
68. End Sub

复制代码

chxw68

纠正了原先发的代码中存在的问题。

poney

这是我要得效果，如果都是标准考场很容易解决，如果遇到非标考场比较麻烦