vba monthview控件64位_用VBA批量格式打印座位号 |VBA应用-CSDN博客

不了解VBA的读者可以移步《VBA| 教你用excel实现随机点名》(点击进入)，本期进一步介绍其应用。

我们在组织考试时，通常先要安排考号，之后书写或打印座位号，粘贴在每位考生的课桌上。我们学校之前在书写座位号时，经常用毛笔，将表示座位号的数字写在一张张小纸片上，按场次分发给各班张贴，这样不但工作量大，而且信息量单一，也很不规范。

自从几年前用了我的小程序之后，工作效率和质量发生了明显变化，下图就是实地拍摄的课桌上的贴好的座位号的例子：

一张小小的纸片上包含了以下信息：考号、场次、班级、姓名。

这样设计的好处显而易见：

制作高效，只需预先输入好学生名单，就可一键打印；
规范；
信息完整，方便现场统计缺考考生，也能防止考生选错座位；

代码编写

首先新建一个空白表(或使用现成的空白表)，改名为“课桌考号”：

然后按Alt+F11进入basic编辑界面，新建一个窗体，按如下的布局组织控件：

这里关键的几个控件的名称——

学校名称对应的text控件更名为：TextBox学校

年级名称对应的ComboBox控件更名为：ComboBox年级

学段对应的ComboBox控件更名为：ComboBox学段

在“考号样式”里，分别预留了3个打印样式，依次是：

Option3列3or4位，

Option2列5or6位，

Option2列8or9位。

在“备注行导引字符”对应的ComboBox控件更名为：

ComboBox引导。

最后“开始”按钮的名称改为：CommandButton开始。

双击“开始”按钮，在代码窗口中，将以下代码复制并粘贴进去：

(滑动阅读)

Private Sub CommandButton开始_Click()

C表 = ""

For Each Sh In Sheets

If Sh.Name = "课桌考号" Then

C表 = "课桌考号"

Exit For

End If

If C表 = "" Then

MsgBox "没有找到表：“课桌考号”，请将盛放原考号的表改名．"

Exit Sub

End If

For Each Sh In Sheets

If Sh.Name = "考号打印" Then

Application.DisplayAlerts = False

Sheets("考号打印").Delete

Application.DisplayAlerts = True

Exit For

End If

With Worksheets

Set Sh = .Add(after:=Worksheets(.Count))

Sh.Name = "考号打印"

End With

lie考号 = MYfound_lie(C表, 1, "考号")

If lie考号 = 0 Then

MsgBox "没有发现字段：考号！"

Exit Sub

End If

lie班级 = MYfound_lie(C表, 1, "班级")

If lie班级 = 0 Then

MsgBox "没有发现字段：班级！"

Exit Sub

End If

lie场 = MYfound_lie(C表, 1, "场")

If lie场 = 0 Then

MsgBox "没有发现字段：场！"

Exit Sub

End If

lie姓名 = MYfound_lie(C表, 1, "姓名")

If lie姓名 = 0 Then

MsgBox "没有发现字段：姓名！"

Exit Sub

End If

myhang1 = ThisWorkbook.Worksheets(C表).UsedRange.Rows.Count '工作表中已使用的行数

mylie1 = 4 ' ThisWorkbook.Worksheets(C表).UsedRange.Columns.Count

'就(场、考号)排序

ThisWorkbook.Worksheets(C表).Select

C字段数 = my字段转换(mylie1)

C字段场 = my字段转换(lie场)

C字段考号 = my字段转换(lie考号)

Range("A1:" & C字段数 & myhang1).Select

Selection.Sort Key1:=Range(C字段场 & 2), Order1:=xlAscending, Key2:= _

Range(C字段考号 & 2), Order2:=xlAscending, Header:=1, OrderCustom:=1, _

MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _

DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

ThisWorkbook.Worksheets("考号打印").Select

'cnj = InputBox("请输入年级", " ")

Ckh = "☆ " & TextBox学校.Text & ComboBox年级.Value & ComboBox学段 & " ☆ (" & Date & ")"

If Option3列3or4位.Value = True Then

a = 3

Else

a = 2

End If

'While a < 2 Or a > 3

'MsgBox "数字范围有误，重新输入吧"

'a = InputBox("打印2列，还是3列？" & Chr(13) & "(考号位数3,或4，请使用3列；" & Chr(13) & " 考号位数5,或6，请使用2列)", "请选择列数", 3)

'Wend

If a = 2 Then 'A4竖排2列

'格式化列

Columns("A:A").HorizontalAlignment = xlCenter

Columns("D:D").HorizontalAlignment = xlCenter

' Selection.Font.Bold = True

Columns("A:A").ColumnWidth = 42 '38 '宽列

Columns("B:C").ColumnWidth = 3 '窄列

Columns("D:D").ColumnWidth = 42 '38

Columns("B:B").Select

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlHairline

End With

With ThisWorkbook.Worksheets("考号打印").Rows("1:" & myhang1 * 4)

.RowHeight = 16

.Font.Name = "楷体_GB2312"

.Font.Bold = False

.Font.Size = 12

End With

h = 1

i = 1

n场0 = ThisWorkbook.Worksheets(C表).Cells.Item(2, lie场).Value

While i <= myhang1 - 1

Nlie = 1

ThisWorkbook.Worksheets("考号打印").Rows(4 * h - 2 & ":" & 4 * h - 2).RowHeight = 105

With ThisWorkbook.Worksheets("考号打印").Range("A" & 4 * h - 2 & ":D" & 4 * h - 2).Font

.Name = "黑体"

If Option2列8or9位.Value = True Then ''8或9位

.Size = 36

ElseIf Option2列5or6位.Value = True Then '5或6位

.Size = 66

Else '3或4位

.Size = 60

End If

' .Size = 72

.Bold = True

End With

'Selection

ThisWorkbook.Worksheets("考号打印").Rows(4 * h - 2 & ":" & 4 * h - 2).VerticalAlignment = xlBottom '纵向对齐：靠下

With ThisWorkbook.Worksheets("考号打印").Rows(4 * h & ":" & 4 * h).Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlHairline

End With

n场0 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie场).Value

N考号 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie考号).Value

N班级 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie班级).Value

n场 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie场).Value

N姓名 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie姓名).Value

C信息 = ComboBox引导.Value & "第" & n场 & "场/ " & N班级 & "班/ " & N姓名

ThisWorkbook.Worksheets("考号打印").Cells.Item(4 * h - 2, Nlie).Value = "'" & N考号

'ThisWorkbook.Worksheets("考号打印").Cells.Item(4 * h - 2, Nlie).NumberFormatLocal = "@"

ThisWorkbook.Worksheets("考号打印").Cells.Item(4 * h - 1, Nlie).Value = C信息

Nlie = Nlie + 3

i = i + 1

Loop Until Nlie > 4

h = h + 1

Wend

Else 'A4竖排 3列

'格式化列

Columns("A:C").HorizontalAlignment = xlCenter

Columns("A:C").ColumnWidth = 30 '列

Columns("B:B").Select

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlHairline

' .ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlHairline

'.ColorIndex = xlAutomatic

End With

With ThisWorkbook.Worksheets("考号打印").Rows("1:" & myhang1 * 4)

.RowHeight = 16

.Font.Name = "楷体_GB2312"

.Font.Size = 12

.Font.Bold = False

End With

h = 1

i = 1

' n场0 = ThisWorkbook.Worksheets(C表).Cells.Item(2, lie场).Value

While i <= myhang1 - 1

Nlie = 1

ThisWorkbook.Worksheets("考号打印").Rows(4 * h - 2 & ":" & 4 * h - 2).RowHeight = 105

With ThisWorkbook.Worksheets("考号打印").Range("A" & 4 * h - 2 & ":C" & 4 * h - 2).Font

.Name = "黑体"

.Size = 72

.Bold = True

End With

ThisWorkbook.Worksheets("考号打印").Rows(4 * h - 2 & ":" & 4 * h - 2).VerticalAlignment = xlBottom '纵向对齐：靠下

With ThisWorkbook.Worksheets("考号打印").Rows(4 * h & ":" & 4 * h).Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlHairline

End With

n场0 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie场).Value

N考号 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie考号).Value

N班级 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie班级).Value

n场 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie场).Value

N姓名 = ThisWorkbook.Worksheets(C表).Cells.Item(i + 1, lie姓名).Value

C信息 = ComboBox引导.Value & "第" & n场 & "场/ " & N班级 & "班/ " & N姓名

' If Ch分页否.Value = True Then

If n场0 <> n场 Then

Exit Do

Else

ThisWorkbook.Worksheets("考号打印").Cells.Item(4 * h - 2, Nlie).Value = "'" & N考号

ThisWorkbook.Worksheets("考号打印").Cells.Item(4 * h - 2, Nlie).NumberFormatLocal = "@"

ThisWorkbook.Worksheets("考号打印").Cells.Item(4 * h - 1, Nlie).Value = C信息

Nlie = Nlie + 1

i = i + 1

End If

Loop Until Nlie > 3

h = h + 1

Wend

End If

'页面设置

ThisWorkbook.Worksheets("考号打印").Select

With ActiveSheet.PageSetup

.PrintTitleRows = ""

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = ""

With ActiveSheet.PageSetup

.LeftHeader = Ckh

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0.196850393700787) '以磅为单位

.RightMargin = Application.InchesToPoints(0.196850393700787) '以磅为单位

.TopMargin = Application.InchesToPoints(0.25) '以磅为单位

.BottomMargin = Application.InchesToPoints(0.25) '以磅为单位

'1磅等于1/72英寸(即1皮卡)，或大约等于1厘米的1/28

'我们可以使用CentimetersToPoints方法就可以实现“厘米”直接转“磅”代码写成:.TopMarginApplication.CentimetersToPoints (2)

.HeaderMargin = Application.InchesToPoints(0)

.FooterMargin = Application.InchesToPoints(0)

.PrintHeadings = False '同时打印行标题和列标题

.PrintGridlines = False

.PrintComments = xlPrintNoComments

'.PrintQuality = 200 '返回或设置打印质量

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlPortrait '返回或设置一个XlPageOrientation值，它代表纵向或横向打印模式。此属性与“方向”选项对应

.Draft = False '不打印工作表中的图形

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic '返回或设置打印指定工作表时第一页的页号如果设为xlAutomatic，则MicrosoftExcel采用第一页的页号?默认值为xlAutomatic Long类型，可读写。此属性与“起始页码”选项对应。

.Order = xlDownThenOver

.BlackAndWhite = False '黑白方式打印否

.Zoom = 100 '缩放比例

.PrintErrors = xlPrintErrorsDisplayed

End With

Cells.Select

Selection.NumberFormatLocal = "0_ " '设置数值格式为0位小数

Unload Me

MsgBox "考号导出完毕！"

ThisWorkbook.Worksheets("考号打印").Cells.Item(1, 1).Select

End Sub

Private Sub UserForm_Activate()

TextBox学校.Text = "19中学 "

ComboBox年级.Clear

ComboBox年级.AddItem "初一年级 "

ComboBox年级.AddItem "初二年级 "

ComboBox年级.AddItem "初三年级 "

ComboBox年级.AddItem "高一年级 "

ComboBox年级.AddItem "高二年级 "

ComboBox年级.AddItem "高三年级 "

ComboBox学段.Clear

ComboBox学段.AddItem "期中考试"

ComboBox学段.AddItem "期末考试"

ComboBox学段.AddItem "月考"

ComboBox引导.Clear

ComboBox引导.AddItem "☆"

ComboBox引导.AddItem "★"

ComboBox引导.AddItem "□"

ComboBox引导.AddItem "■"

ComboBox引导.AddItem "△"

ComboBox引导.AddItem "▲"

ComboBox引导.AddItem "◆"

ComboBox引导.AddItem "※"

ComboBox引导.AddItem "＃"

ComboBox引导.Value = "■"

myhang1 = ThisWorkbook.Worksheets("课桌考号").UsedRange.Rows.Count '工作表中已使用的行数

L考号 = MYfound_lie("课桌考号", 1, "考号")

N考号 = Val(ThisWorkbook.Worksheets("课桌考号").Cells.Item(2, L考号).Value)

For i = 2 To myhang1 Step 10

kh = Val(ThisWorkbook.Worksheets("课桌考号").Cells.Item(i, L考号).Value)

If kh > N考号 Then N考号 = kh

Next i

Nweishu = Len(Trim(Str(N考号)))

If N考号 < 10000 Then

Option3列3or4位.Value = True

ElseIf N考号 < 10000000 Then

Option2列5or6位.Value = True

Else

Option2列8or9位.Value = True

End If

End Sub

Private Sub UserForm_Click()

End Sub

新建一个模块，输入以下代码：

(滑动阅读)

Sub 导出考号()

'检查表"考号打印"是否存在，若存在就删除重新添加一个

form打印参数.Show

End Sub

Sub 竞赛考号打印()

'检查表"考号打印"是否存在，若存在就删除重新添加一个

UserForm竞赛.Show

End Sub

Function MYfound_lie(C_biao, n_hang, C_xm)

'在Cbiao 指定表中的指定行 n_hang 查找对应名称C_xm 所在列

lyou = False '是否有lskey

For Each Sh In Worksheets

If Sh.Name = C_biao Then

lyou = True

Exit For

End If

If lyou = False Then

MsgBox "没有找到表" & C_biao

MYfound_lie = 0

Exit Function

End If

Mylie11 = ThisWorkbook.Worksheets(C_biao).UsedRange.Columns.Count '工作表中已使用的列数

MYfound_lie = 0

For Ni = 1 To Mylie11

If ThisWorkbook.Worksheets(C_biao).Cells.Item(n_hang, Ni) = C_xm Then '''''''''

MYfound_lie = Ni

Exit For

End If

Next Ni

End Function

Function my字段转换(L列)

zfj = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

n = Int(L列 / 26)

ny = L列 Mod 26

If ny = 0 Then

n = n - 1

ny = 26

End If

If n > 0 Then

my字段转换 = Mid(zfj, n, 1) & Mid(zfj, ny, 1)

Else

my字段转换 = Mid(zfj, ny, 1)

End If

End Function

下面为该功能指定一个入口，回到excel的任意一个空白表中，插入一个按钮或绘制一个自己认为合适的图形，右击，指定宏：

找到“导出考号”，选中并确定返回(这里的已经在模块代码中预先定义过“导出考号”这个过程了，因此在这里会看到它)。

至此，代码编写完毕。

打印座位号

首先在“课桌考号”表中灌入你要打印的学生名单，注意按“场、姓名、班级、考号”字段(表的第一行)指定，不要随意更改。然后点击你刚才自定义的按钮，就会弹出如下对话窗体：

这里要根据本校学生考号的位数，选择对应的样式

其他项目根据需要填写即可。

等一切准备就绪，点击“开始”按钮。

系统会自动生成一个名为“考号打印”的新表，表中的内容如下，其中座位号之间用虚线分割，方便将来裁剪。下图是在excel中未打印时的预览图：

下面转备好打印机和一定量的A4打印纸，利用excel自带的打印功能，直接打印就可以了。

以上打印的座位号时按照场次逐场打印的，打印完成后，分发给各班并沿打印纸的虚线剪开，就得到一张张座位号了。

往期精彩不容错过

2020年最新高考过渡时期数学学科考试范围说明
几种圆柱侧面展开动画演示 | 几何画板
解密“侧面展开的一种做法” | 几何画板
说说新高考赋分
动画分享：无限正方形 | 几何画板与GeoGebra对照编写
任意四边形变长方形 | 几何画板与GeoGebra对照编写
荐读 | 庚子赔款与清华园
几何画板晋级之路(12) | 将动画进行到底
PPT | 好课件的一般“标准”
教学随笔 | “三维坐标法”判断复合函数零点个数
几何画板 | 网红动图演绎：π的直观解释
几何画板 | 放大镜效果的制作
几何画板晋级之路(10)|图片操作(2)
几何画板晋级之路(6)|3D平台初步(1)
PPT |班主任素质大赛课件示例
PPT |高中数学说课课件示例
几何画板晋级之路(3)|迭代——挑战操作的极限
几何画板晋级之路|参数——动态几何的灵魂
PPT课件| 封面就是一张脸，你要不要
高中数学始业教育PPT、word文档+初高中衔接教材(3套)，课件资源一网打尽
培训笔记 | 提高教学技能，追求业务精湛
VBA| 教你用excel实现随机点名
河北2019中考画板演绎合集(提供源文件)
PPT | 形状的布尔运算简介

(技术交流，请先关注，后台输入“作者”)