用Excel和VBA轻松实现桌签批量打印
标签打印机的快速批量打印方法
选择打开自己编辑好的标签模式
在需要打印的标签序号前打勾
点击预览、打印，即可自动批量打印。
结论：可自动打印编辑好的大批量标签，打印时不再每打一张切割1/4，每盒节约80×1/4＝20元。效率提高，劳动强度降低。
标签打印机的快速批量打印方法
问题描述：目前标签打印机一个标签一个标签打印，速度慢，劳动时间长，每次打完，标签打印机要切割一小部分，占总打印纸的1/4，浪费纸张，不环保。
解决设想：能否把所有的标签排版好，让标签打印机自动打印。
解决方案：
1建立要打印的标签的EXCEL表格
2在P-touch Editor 4.2里导入EXCEL表
巧用VBA编程实现EXCEL电子表格的批量自动打印
巧用VBA编程实现EXCEL证件的批量打印夏教荣陈文涛（湖南省邵阳县白仓镇中学421114）摘要介绍了在EXCEL中如何使用VBA,通过实例论述了在EXCEL中可以通过VBA编程实现含有照片的电子证件或表格批量自动打印，提高了EXCEL在实际应用中的工作效率及节省人力资源。
关键词VBA编程自动打印EXCEL一VBA简介1、什么是VBA？VBA是Visual Basic For Application的缩写，它是以Visual Basic为发展基础的语言。
在Office软件中，VBA应用程序能够在Word、Access、Excel等之间进行交互式应用，加强了应用程序间的互动。
VBA是VB的应用程序版本，可以理解为“寄生在Office办公软件中的VB”，可以看作是VB语言的一个子集。
VBA使Office形成了独立的编程环境。
2、VBA与Visual Basic的关系1）、VB用于开发Windows应用程序，其代码最终被编译为可执行程序。
而VBA是用于控制已有应用程序的自动化操作，其代码为解释。
2）、VB拥有独立的开发环境，而VBA必须集成在已有的应用程序中(Excel等)。
3）、VB开发出来的应用程序在脱离开发环境后仍能执行，而VBA编写出来的程序必须在访问集成应用程序(Excel等)的基础上进行。
尽管有以上不同，但它们仍然非常相似。
都使用相同的语言结构。
两者的程序的语法及程序流程完全一样。
二、在Excel中使用VBA1、进入VBA的方法下面以Office2010为例说明来进入VBA的方法：功能区中有一个“开发工具”选项卡，在此可以访问 Visual Basic 编辑器和其他开发人员工具。
由于 Office 2010 在默认情况下不显示“开发工具”选项卡，因此必须使用以下过程启用该选项卡：1）、在“文件”选项卡上，选择“选项”打开“Excel 选项”对话框。
2）、单击该对话框左侧的“自定义功能区”。
用VBA实现EXCEL表中行标签打印
Public Sub 标签打印1()Application.OnKey "^b", "标签打印"Dim s, t, I, j, m, n As IntegerDim MySelect As RangeSet MySelect = Application.InputBox("请输入或者框选标签打印区域:", "指定行或单元格区域", Type:=8)'如果myselect 是空退出过程,对用户点击输入框的取消按钮后作出判断.If MySelect Is Nothing Then Exit SubI = Range(MySelect.Address).Row '计算首行数ij = Range(MySelect.Address).Rows.Count + I - 1 ',计算末行数js = edRange.Row() - 1 + edRange.Rows.Count '数据区最大行t = edRange.Column() - 1 + edRange.Columns.Count '数据区最大列Columns(t + 1).ColumnWidth = 40 '改变工作表列t+1的宽度为20Rows(s + 1).RowHeight = 20 '改变工作表的行s+1的高度值设置为20Rows(s + 2).RowHeight = 50 '改变工作表的行s+2的高度值设置为50Rows(s + 3).RowHeight = 20 '改变工作表的行s+3的高度值设置为20 Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).HorizontalAlignment = xlLeft '水平左对齐With Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).Characters.Font.Name = "华文楷体".FontStyle = "常规".Size = 16End WithFor m = I To jCells(s + 1, t + 1).Value = Cells(m, 1).Value 'Cells(s + 2, t + 1).Value = Cells(m, 3).Value 'Cells(s + 3, t + 1).Value = Cells(m, 6).Value 'n = InputBox("当前标签-----" & Cells(m, 1).Value & "----的打印份数")On Error GoTo 100Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).PrintOut Copies:=n, Collate:=TrueActiveSheet.Range(Cells(s + 1, t + 1), Cells(s + 3, t + 1)).Clear '数据清除100 Next m'恢复行高列宽为标准值ActiveSheet.Columns(t + 1).ColumnWidth = StandardWidthActiveSheet.Rows(s + 1).RowHeight = StandardHeightActiveSheet.Rows(s + 2).RowHeight = StandardHeightActiveSheet.Rows(s + 3).RowHeight = StandardHeightEnd Sub。
自己用VBA编的批量打印程序（原创）
自己用VBA编的批量打印程序（原创）Option Explicit'图形集合Private colDwgs As New Collection'文档对象Dim objDoc As AcadDocument'布局对象Dim objLayout As AcadLayout'打印对象Dim objPlot As AcadPlotPrivate Type BrowseInfohOwner As LongpidlRoot As LongpszDisplayName As StringlpszTitle As StringulFlags As Longlpfn As LonglParam As LongiImage As LongEnd TypePrivate Const MAX_PATH = 260'代表ESC键Private Const VK_ESCAPE = &H1B'API函数的声明Private Declare Function SHBrowseForFolder Lib "shell32.dll" _Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As LongPrivate Declare Function FindWindow Lib "user32" Alias"FindWindowA" (ByVal lpClassName As String, _ByVal lpWindowName As String) As LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal _pidl As Long, ByVal pszPath As String) As LongPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer' 功能：判断用户是否按下某一个键' 输入：代表键的常量（从API Viewer中获得）' 调用：API函数GetAsyncKeyState' 返回：如果用户按下了指定的键，返回True；否则返回False' 示例：' If CheckKey(&H1B) = True Then do sthPrivate Function CheckKey(lngKey As Long) As BooleanIf GetAsyncKeyState(lngKey) ThenCheckKey = TrueElseCheckKey = FalseEnd IfEnd FunctionPrivate Sub cboPaperSize_Change()'若组合框非空If cboPaperSize.Text <> "" Then' 设置图纸尺寸objLayout.CanonicalMediaName = cboPaperSize.Text' 显示图纸尺寸Call SetPlotZoneEnd IfEnd SubPrivate Sub cboPlotScale_Click()If cboPlotScale.Value TheneStandardScale = True '使用标准打印比例ElseeStandardScale = False '使用自定义打印比例End IfSelect Case cboPlotScale.ValueCase 0'txtNumerator = 1'txtDenominator = 1Case 1objLayout.StandardScale = acScaleToFit txtNumerator = 1txtDenominator = ""Case 2objLayout.StandardScale = ac1_1txtNumerator = 1txtDenominator = 1Case 3objLayout.StandardScale = ac1_2txtNumerator = 1txtDenominator = 2Case 4objLayout.StandardScale = ac1_4txtNumerator = 1txtDenominator = 4Case 5objLayout.StandardScale = ac1_8txtNumerator = 1txtDenominator = 8Case 6objLayout.StandardScale = ac1_10 txtNumerator = 1 txtDenominator = 10Case 7objLayout.StandardScale = ac1_16 txtNumerator = 1 txtDenominator = 16Case 8objLayout.StandardScale = ac1_20 txtNumerator = 1 txtDenominator = 20Case 9objLayout.StandardScale = ac1_30 txtNumerator = 1 txtDenominator = 30Case 10objLayout.StandardScale = ac1_40 txtNumerator = 1 txtDenominator = 40Case 11objLayout.StandardScale = ac1_50 txtNumerator = 1 txtDenominator = 50Case 12objLayout.StandardScale = ac1_100 txtNumerator = 1 txtDenominator = 100Case 13objLayout.StandardScale = ac2_1 txtNumerator = 2txtDenominator = 1Case 14objLayout.StandardScale = ac4_1txtNumerator = 4txtDenominator = 1Case 15objLayout.StandardScale = ac8_1txtNumerator = 8txtDenominator = 1Case 16objLayout.StandardScale = ac10_1txtNumerator = 10txtDenominator = 1Case 17objLayout.StandardScale = ac100_1txtNumerator = 100txtDenominator = 1End SelectEnd SubPrivate Sub cboPlotStyleTableNames_Change()' 设置打印样式表objLayout.StyleSheet = cboPlotStyleT ableNames.TextEnd SubPrivate Sub cboPrintersName_Change()On Error Resume Next' 设置打印机配置（对应AutoCAD中：打印>打印设备>打印机配置>"DWF6 ePlot.pc3"）objLayout.ConfigName = cboPrintersName.Text' 更新显示AutoCAD中当前可用的所有图纸尺寸Call ListPaperSize' 更新显示AutoCAD中当前可用的所有打印样式表Call ListPlotStyleTableNamesEnd SubPrivate Sub chkCenterPlot_Change()Dim PtOffset(0 To 1) As Double' 设置图纸是否居中打印If chkCenterPlot.Value ThenPtOffset(0) = 0PtOffset(1) = 0ElsePtOffset(0) = -5PtOffset(1) = -5End IftxtOffsetX.Value = PtOffset(0)txtOffsetY.Value = PtOffset(1)End SubPrivate Sub chkPlotHidden_Change()'设置是否隐藏图纸空间对象If chkPlotHidden.Value Then'打印时隐藏图纸空间对象objLayout.PlotHidden = TrueElse'打印时不隐藏图纸空间对象objLayout.PlotHidden = FalseEnd IfEnd SubPrivate Sub chkPlotToFile_Change()'设置“打印到文件”组各控件激活状态If chkPlotT oFile.Value ThenlbPlotPath.Enabled = TruecboPlotPath.Enabled = TruecmdBrowse2.Enabled = TrueElselbPlotPath.Enabled = FalsecboPlotPath.Enabled = FalsecmdBrowse2.Enabled = FalseEnd IfEnd SubPrivate Sub chkPlotWithLineweights_Change() '设置是否打印对象线宽If chkPlotWithLineweights.Value Then'打印时使用图形文件中的线宽objLayout.PlotWithLineweights = TrueElse'打印时使用打印样式中的线宽objLayout.PlotWithLineweights = FalseEnd IfEnd SubPrivate Sub chkPlotWithPlotStyles_Change() '设置是否应用打印样式If chkPlotWithPlotStyles.Value Then'打印时在对象中使用打印样式objLayout.PlotWithPlotStyles = True chkPlotWithLineweights.Enabled = False Else'打印时在对象中不使用打印样式objLayout.PlotWithPlotStyles = False chkPlotWithLineweights.Enabled = TrueEnd IfEnd Sub' 设置图纸打印方向Call PaperRotationChangeEnd SubPrivate Sub cmdAdd_Click()'如果列表框中未存在任何元素If lstCurFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCritical Exit SubEnd IfDim strFlies As StringDim i As IntegerDim n As Integern = 0'将上面列表框中选中的对象添加到下面的列表框中For i = 0 To lstCurFiles.ListCount - 1If lstCurFiles.Selected(i) ThenstrFlies = lstCurFiles.List(i)n = n + 1If Not HasItem(lstPlotFiles, strFlies) Then lstPlotFiles.AddItem lstCurFiles.List(i) 'End IfEnd IfNext i'如果列表框中未存在被选择的元素If n = 0 ThenMsgBox "请选择要从列表中添加的元素！", vbCritical Exit SubEnd IfEnd Sub'如果列表框中未存在任何元素If lstCurFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCriticalExit SubEnd IfDim strFlies As StringDim i As Integer'将上面列表框中选中的对象添加到下面的列表框中For i = 0 To lstCurFiles.ListCount - 1strFlies = lstCurFiles.List(i)If Not HasItem(lstPlotFiles, strFlies) Then lstPlotFiles.AddItem lstCurFiles.List(i)End IfNext iEnd SubPrivate Sub cmdBrowse_Click()'在文本框中显示获得的路径txtCurPath.Text = ReturnFolder(0)End SubPrivate Sub cmdBrowse2_Click()Dim strPath As StringstrPath = ReturnFolder(0)'若返回文件夹路径非空If strPath <> "" Then'若组合框中未存在返回文件夹路径，则将其添加到组合框中If HasItem2(strPath) < 0 Then'在组合框中显示获得的路径With cboPlotPath.AddItem strPath, 0'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End With'若组合框中已存在返回文件夹路径，则将返回文件夹路径置为选中ElseWith cboPlotPath'设置默认的显示项目.ListIndex = HasItem2(strPath)End WithEnd IfEnd IfEnd SubPrivate Sub cmdClear_Click()'如果列表框中未存在任何元素If lstPlotFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCriticalExit SubEnd IfDim i As Integer, n As Integer, count As Integer'列表框中元素的数量count = lstPlotFiles.ListCountn = 0'将列表框中选中的对象删除For i = 0 To count - 1If lstPlotFiles.Selected(i) Thenn = n + 1Else'移动列表框中的元素lstPlotFiles.List(i - n) = lstPlotFiles.List(i)End IfNext i'如果列表框中未存在被选择的元素If n = 0 ThenMsgBox "请选择要从列表中清除的元素！", vbCritical Exit SubEnd If'删除最后n行的元素For i = 1 To nlstPlotFiles.RemoveItem (count - i)Next iEnd SubPrivate Sub cmdClearAll_Click()'如果列表框中未存在任何元素If lstPlotFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCriticalExit SubEnd IfDim Msg, Style, Title, Help, Ctxt, Response, MyStringMsg = "清除整个图形列表?"Style = vbOKCancel + vbQuestion + vbDefaultButton2 Title = "Clear Files"Response = MsgBox(Msg, Style, Title)If Response = vbOK ThentxtCurPath.Text = ""'清除列表框中所有元素lstPlotFiles.ClearEnd IfEnd SubPrivate Sub cmdExit_Click()'退出EndEnd SubPrivate Sub cmdInput_Click()'导入打印设置'设置标准对话框With comDlg'设置标准对话框标题.DialogTitle = "导入打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'设置标准对话框的起始目录'.InDir = "C:\"'显示[打开]对话框.ShowOpenEnd WithDim strFileName As StringstrFileName = comDlg.fileName'strFileName = "F:\AutoCAD\丹通施工图\打印设置.txt" '若返回文件名为空，不进行操作If strFileName = "" ThenMsgBox "请重新选择文件位置！"Exit SubEnd If'读入文件的操作Dim i As Integer, nFile As IntegerDim x As Double, y As DoubleDim count As Integer, index As IntegerDim strTemp As String'获得下一个可供Open语句使用的文件号nFile = FreeFile'打开文件Open strFileName For Input As #nFile'读入当前路径'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入当前路径并设置文本框文字Input #nFile, strTemptxtCurPath.Text = strTemp'读入打印文件列表并添加到列表框中Call InputData3(lstPlotFiles, nFile)'读入打印机配置列表并添加到组合框中Call InputData(cboPrintersName, nFile)'读入打印样式表并添加到组合框中Call InputData(cboPlotStyleTableNames, nFile)'读入图纸尺寸列表并添加到组合框中Call InputData(cboPaperSize, nFile)'读入图纸单位并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图纸单位Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "毫米" Then optMillimeters.Value = TrueElseoptInches.Value = TrueEnd If'读入图纸方向并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图纸方向Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "纵向" ThenoptVertical.Value = TrueElseoptHorizontal.Value = TrueEnd If'读入是否反向打印并设置复选按钮选择状态Call InputData2(chkReverse, nFile)'读入打印份数'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入打印份数Input #nFile, count'设置文本框文字txtNumber.Text = count'读入是否打印到文件并设置复选按钮选择状态Call InputData2(chkPlotToFile, nFile)'读入打印路径列表并添加到组合框中Call InputData(cboPlotPath, nFile)'读入打印比例列表并添加到组合框中Call InputData(cboPlotScale, nFile)'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入当前打印比例并设置文本框文字Input #nFile, xInput #nFile, ytxtNumerator.Text = xtxtDenominator.Text = y'读入是否居中打印并设置复选按钮选择状态Call InputData2(chkCenterPlot, nFile)'读入打印偏移'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入打印偏移并设置文本框文字Input #nFile, xInput #nFile, ytxtOffsetX.Text = xtxtOffsetY.Text = y'读入是否打印对象线宽并设置复选按钮选择状态Call InputData2(chkPlotWithLineweights, nFile) '读入是否采用打印样式并设置复选按钮选择状态Call InputData2(chkPlotWithPlotStyles, nFile)'读入是否隐藏图纸空间对象并设置复选按钮选择状态Call InputData2(chkPlotHidden, nFile)'读入图框形式并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图框形式Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "图块" ThenoptBlock.Value = TrueElseoptLayer.Value = TrueEnd If'读入图块名列表并添加到组合框中Call InputData(cboBlockName, nFile)'读入图层名列表并添加到组合框中Call InputData(cboLayerName, nFile)'关闭文件Close #nFileEnd SubPrivate Sub cmdListPrints_Click()' 显示AutoCAD中当前可用的打印机列表Call ListPrintersEnd SubPrivate Sub cmdOutput_Click()'导出打印设置'设置标准对话框With comDlg'设置标准对话框标题.DialogTitle = "导出打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*" '设置标准对话框的起始目录'.InDir = "C:\"'设置[另存为]对话框的缺省扩展名.DefaultExt = "txt"'显示[另存为]对话框.ShowSaveEnd WithDim strFileName As String, strTemp As String strFileName = comDlg.fileName'strFileName = "F:\AutoCAD\丹通施工图\打印设置.txt" '若返回文件名为空，不进行操作If strFileName = "" ThenMsgBox "请重新选择保存位置！"Exit SubEnd If'保存文件的操作Dim i As Integer'打开文件Open strFileName For Output As #1'输出当前路径Print #1, "当前路径："Print #1, txtCurPath.Text'输出打印文件列表Print #1, "打印文件列表："'输出打印机配置列表的信息Call OutputData3(lstPlotFiles, 1)'输出打印机配置Print #1, "打印机配置："'输出打印机配置列表的信息Call OutputData(cboPrintersName, 1)Print #1, "打印样式表："'输出打印样式表的信息Call OutputData(cboPlotStyleTableNames, 1)'输出图纸尺寸列表Print #1, "图纸尺寸列表："'输出图纸尺寸列表的信息Call OutputData(cboPaperSize, 1)'输出图纸单位Print #1, "图纸单位："'输出图纸单位信息If optMillimeters.Value = True Then strTemp = "毫米"ElsestrTemp = "英寸"End IfPrint #1, strTemp'输出图纸方向Print #1, "图纸方向："'输出图纸方向信息If optVertical.Value = True ThenstrTemp = "纵向"ElsestrTemp = "横向"End IfPrint #1, strTempPrint #1, "是否反向打印："Call OutputData2(chkReverse, 1)'输出打印份数Print #1, "打印份数："Print #1, txtNumber.Text'输出是否打印到文件Print #1, "是否打印到文件："Call OutputData2(chkPlotToFile, 1)'输出打印路径Print #1, "打印路径："'输出打印路径列表的信息Call OutputData(cboPlotPath, 1)'输出打印比例Print #1, "打印比例："'输出打印比例列表的信息Call OutputData(cboPlotScale, 1)'输出当前打印比例Print #1, "当前打印比例："Print #1, txtNumerator.TextPrint #1, txtDenominator.Text'输出是否居中打印Print #1, "是否居中打印："Call OutputData2(chkCenterPlot, 1)'输出打印偏移Print #1, "打印偏移："Print #1, txtOffsetX.TextPrint #1, txtOffsetY.Text'输出是否打印对象线宽Print #1, "是否打印对象线宽："Call OutputData2(chkPlotWithLineweights, 1) '输出是否采用打印样式Print #1, "是否采用打印样式："Call OutputData2(chkPlotWithPlotStyles, 1) '输出是否隐藏图纸空间对象Print #1, "是否隐藏图纸空间对象："Call OutputData2(chkPlotHidden, 1)'输出图框形式Print #1, "图框形式："'输出图框形式信息If optBlock.Value = True ThenstrTemp = "图块"ElsestrTemp = "图层"End IfPrint #1, strTemp'输出图块名列表Print #1, "图块名列表："'输出图块名列表的信息Call OutputData(cboBlockName, 1)'输出图层名列表Print #1, "图块名列表："'输出图层名列表的信息Call OutputData(cboLayerName, 1)'关闭文件Close 1End SubPrivate Sub cmdPick_Click()On Error Resume NextDim objSelect As AcadEntityDim ptPick As VariantDim strTemp As StringSet objDoc = ThisDrawing.Application.ActiveDocument'将控制权交给AutoCADfrmBatchPlot.Hide'在AutoCAD中选择实体并判断类型Retry:objDoc.Utility.GetEntity objSelect, ptPick, vbCrLf & "请选择实体："' 处理按下Esc键的错误If objSelect Is Nothing ThenIf CheckKey(VK_ESCAPE) = True Then'显示对话框frmBatchPlot.ShowExit SubElseGoTo RetryEnd IfEnd If' 处理未选择到实体的错误If Err <> 0 ThenErr.ClearGoTo RetryEnd If'若为指定图块If optBlock.Value = True Then'判断实体是否块参照If TypeOf objSelect Is AcadBlockReference Then'判断实体是否模型空间、图纸空间和匿名块If StrComp(Left(, 1), "*") <> 0 Then'获得块参照名strTemp = ElseMsgBox "您选择的是匿名块，请重新选择块参照！", vbCritical '显示对话框frmBatchPlot.ShowExit SubEnd IfElseMsgBox "您选择的不是块参照，请重新选择块参照！", vbCritical'显示对话框frmBatchPlot.ShowExit SubEnd If'刷新块参照列表Call ListBlock'将所选块参照在组合框中置为当前Call SetSelected(cboBlockName, strTemp)Else'判断实体是否多段线If TypeOf objSelect Is AcadLWPolyline Then'获得多段线所在图层名strTemp = yerElseMsgBox "您选择的不是轻量多段线，请重新选择轻量多段线！", vbCritical'显示对话框frmBatchPlot.ShowExit SubEnd If' 刷新图层列表Call ListLayer'将所选实体所在图层在组合框中置为当前Call SetSelected(cboLayerName, strTemp)End If'显示对话框frmBatchPlot.ShowEnd SubPrivate Sub SetSelected(ListObject As Object, SItem As String) '将该元素在组合框中置为当前Dim i As Long'通过比较确定该元素的位置For i = 0 To (ListObject.ListCount - 1)If StrComp(ListObject.List(i), SItem, vbTextCompare) = 0 ThenListObject.ListIndex = iExit SubEnd IfNextEnd SubPrivate Sub cmdPreview_Click()'若按图块进行批量打印If optBlock.Value = True ThenIf cboBlockName.ListCount = 0 Or cboBlockName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall PreviewByBlock(cboBlockName.T ext)'若按图层进行批量打印ElseIf cboLayerName.ListCount = 0 Or cboLayerName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall PreviewByLayer(cboLayerName.T ext)End IfEnd SubPrivate Sub cmdRefresh_Click()'刷新块参照列表Call ListBlock' 刷新图层列表Call ListLayerEnd SubPrivate Sub cmdPlot_Click()'若按图块进行批量打印If optBlock.Value = True ThenIf cboBlockName.ListCount = 0 Or cboBlockName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall BatchPlotByBlock(cboBlockName.Text)'若按图层进行批量打印ElseIf cboLayerName.ListCount = 0 Or cboLayerName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall BatchPlotByLayer(cboLayerName.Text)End IfEnd SubPrivate Sub cmdAbout_Click()'显示关于对话框frmAbout.ShowEnd SubPrivate Sub optBlock_Change()'设置“图块与图层”组各控件激活状态If optBlock.Value = True ThenlbBlockName.Enabled = TruecboBlockName.Enabled = TruelbLayerName.Enabled = False cboLayerName.Enabled = False ElselbBlockName.Enabled = False cboBlockName.Enabled = False lbLayerName.Enabled = True cboLayerName.Enabled = TrueEnd IfEnd SubPrivate Sub optLayer_Change()'设置“图块与图层”组各控件激活状态If optBlock.Value = True Then lbBlockName.Enabled = True cboBlockName.Enabled = True lbLayerName.Enabled = False cboLayerName.Enabled = False ElselbBlockName.Enabled = False cboBlockName.Enabled = False lbLayerName.Enabled = True cboLayerName.Enabled = TrueEnd IfEnd SubPrivate Sub optMillimeters_Change() ' 设置图纸单位If optMillimeters.Value = True Then objLayout.PaperUnits = acMillimeters lbUnit.Caption = "毫米＝" lbUnitX.Caption = "毫米" lbUnitY.Caption = "毫米"lbPaperUnit.Caption = "毫米"ElseobjLayout.PaperUnits = acInches lbUnit.Caption = "英寸＝"lbUnitX.Caption = "英寸"lbUnitY.Caption = "英寸" lbPaperUnit.Caption = "英寸"End If' 显示图纸尺寸Call SetPlotZoneEnd SubPrivate Sub OptVertical_Change()' 设置图纸打印方向Call PaperRotationChangeEnd SubPrivate Sub spnAngle_SpinDown()If CInt(txtNumber.T ext) > 1 Then txtNumber.Text = CInt(txtNumber.Text) - 1 End IfEnd SubPrivate Sub spnAngle_SpinUp() txtNumber.Text = CInt(txtNumber.Text) + 1 End SubPrivate Sub txtCurPath_Change()'查找文件，向列表框中添加If Len(Dir(txtCurPath.Text)) > 0 Then FindFile colDwgs, txtCurPath.Text, "dwg" If AddToList(lstCurFiles, colDwgs) Then End IfEnd IfEnd SubPrivate Sub txtDenominator_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If IsNumeric(txtDenominator) Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex = 0ElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub txtNumber_Change()' 设置图纸打印份数'objPlot.NumberOfCopies = CDbl(txtNumber.Text)'objPlot.NumberOfCopies = CInt(txtNumber.Text)objPlot.NumberOfCopies = txtNumber.ValueEnd SubPrivate Sub txtNumerator_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If IsNumeric(txtNumerator) Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex = 0ElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub txtOffsetX_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then'取消“居中打印”复选框chkCenterPlot.Value = FalseElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub txtOffsetY_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then'取消“居中打印”复选框chkCenterPlot.Value = FalseElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub UserForm_Initialize()Set objDoc = ThisDrawing.Application.ActiveDocumentSet objLayout = ThisDrawing.ActiveLayoutSet objPlot = ThisDrawing.Plot'禁用“当前路径”文本框txtCurPath.Enabled = False'列出当前所有打印机Call ListPrinters' 显示AutoCAD中当前可用的打印比例列表Call ListPlotScale'设置“打印到文件”是否选中chkPlotToFile.Value = False'禁用“打印到文件”组各控件lbPlotPath.Enabled = FalsecboPlotPath.Enabled = FalsecmdBrowse2.Enabled = False' 显示AutoCAD中当前可用的图块Call ListBlock' 显示AutoCAD中当前可用的图层Call ListLayerEnd SubPublic Function ReturnFolder(lngHwnd As Long) As String Dim Browser As BrowseInfoDim lngFolder As LongDim strPath As StringDim strTemp As StringWith Browser.hOwner = lngHwnd.lpszTitle = "选择工作路径".pszDisplayName = String(MAX_PATH, 0)End With'用空格填充字符串strPath = String(MAX_PATH, 0)'调用API函数显示文件夹列表lngFolder = SHBrowseForFolder(Browser)'使用API函数获取返回的路径If lngFolder ThenSHGetPathFromIDList lngFolder, strPathstrTemp = Left(strPath, InStr(strPath, vbNullChar) - 1)If (Right(strTemp, 1) <> "\") ThenstrTemp = strTemp & "\"End IfReturnFolder = strTempEnd IfEnd FunctionPublic Sub FindFile(ByRef files As Collection, strDir, strExt) '删除集合中所有的对象Dim i As IntegerFor i = 1 To files.countfiles.Remove 1Next i'查找dwg文件，并将其添加到集合中Dim strFileName As StringIf (Right(strDir, 1) <> "\") ThenstrDir = strDir & "\"End IfstrFileName = Dir(strDir & "*.*", vbDirectory)Do While (strFileName <> "")If (UCase(Right(strFileName, 3)) = UCase(strExt)) Thenfiles.Add strDir & strFileNameEnd IfstrFileName = Dir '返回下一个符合条件的文件LoopEnd SubPublic Function AddToList(objBox As ListBox, Names As Collection) As BooleanDim i As IntegerOn Error GoTo Error_ControlobjBox.Clear'将集合中的对象添加到列表框中For i = 1 To Names.countobjBox.AddItem Names(i)Next iExit_Here:AddToList = TrueExit FunctionError_Control:MsgBox "发生下面的错误：" & Err.NumberAddToList = FalseEnd FunctionPrivate Function HasItem(objBox As ListBox, strFlies As String) As Boolean'检查路径是否已经存在HasItem = FalseDim i As IntegerIf objBox.ListCount > 0 ThenFor i = 0 To objBox.ListCount - 1If StrComp(objBox.List(i), strFlies, vbT extCompare) = 0 Then HasItem = TrueExit FunctionEnd IfNext iEnd IfEnd FunctionPrivate Function HasItem2(ByVal strPath As String) As Integer'检查路径是否已经存在HasItem2 = -1Dim i As IntegerIf cboPlotPath.ListCount > 0 ThenFor i = 0 To cboPlotPath.ListCount - 1If StrComp(cboPlotPath.List(i), strPath, vbTextCompare) = 0 ThenHasItem2 = iExit FunctionEnd IfNext iEnd IfEnd Function'打开或激活文件Private Sub OpenFile(fileName As String)Dim dwgFile As AcadDocumentDim strFile As StringFor Each dwgFile In ThisDrawing.Application.Documents strFile = dwgFile.Path & "\" & '若第i个图形文件已经被打开，则将其激活If strFile = fileName Then'若dwgFile尚未激活，则将其激活If dwgFile.Active = False ThenThisDrawing.Application.ActiveDocument = dwgFile End IfExit SubEnd IfNext'若第i个图形文件尚未被打开，则将其打开ThisDrawing.Application.Documents.Open fileNameEnd Sub' 显示AutoCAD中当前可用的打印机列表Public Sub ListPrinters()objLayout.RefreshPlotDeviceInfo' 获得所有的可用打印机Dim plotDevices As VariantplotDevices = objLayout.GetPlotDeviceNames' 删除以前的打印机列表cboPrintersName.Clear' 显示打印机列表Dim i As IntegerFor i = 0 To UBound(plotDevices) cboPrintersName.AddItem (plotDevices(i))Next i' 设置组合框初始选项With cboPrintersName'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 1End WithEnd Sub' 显示AutoCAD中当前可用的打印样式Public Sub ListPlotStyleTableNames()Set objLayout = ThisDrawing.ActiveLayout objLayout.RefreshPlotDeviceInfo' 获得所有的可用打印样式Dim plotStyleTables As VariantplotStyleTables = objLayout.GetPlotStyleTableNames' 删除以前的打印样式列表cboPlotStyleTableNames.Clear' 显打印样式列表Dim i As IntegerFor i = 0 To UBound(plotStyleTables) cboPlotStyleTableNames.AddItem (plotStyleTables(i)) Next i' 设置组合框初始选项With cboPlotStyleT ableNames'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End WithEnd Sub' 显示AutoCAD中当前可用的图纸尺寸Public Sub ListPaperSize()objLayout.RefreshPlotDeviceInfo' 获得所有当前可用可用图纸尺寸列表Dim paperSizes As VariantpaperSizes = objLayout.GetCanonicalMediaNames' 删除以前的图纸尺寸列表cboPaperSize.Clear' 显示图纸尺寸列表Dim i As IntegerFor i = 0 To UBound(paperSizes) cboPaperSize.AddItem (paperSizes(i))Next i' 设置组合框初始选项With cboPaperSize'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End WithEnd Sub' 显示AutoCAD中可以使用的打印比例Public Sub ListPlotScale()' 显打印比例列表With cboPlotScale.AddItem ("自定义"), 0.AddItem ("按图纸空间缩放"), 1.AddItem ("1:1"), 2.AddItem ("1:2"), 3.AddItem ("1:4"), 4.AddItem ("1:8"), 5.AddItem ("1:10"), 6.AddItem ("1:16"), 7.AddItem ("1:20"), 8.AddItem ("1:30"), 9.AddItem ("1:40"), 10.AddItem ("1:50"), 11.AddItem ("1:100"), 12.AddItem ("2:1"), 13.AddItem ("4:1"), 14.AddItem ("8:1"), 15.AddItem ("10:1"), 16.AddItem ("100:1"), 17'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 2End WithtxtNumerator = 1txtDenominator = 1End Sub' 显示AutoCAD中当前可用的图层Public Sub ListLayer()Dim LayerList As Collection'获得图形中存在的图层列表Set LayerList = GetLayerList()'刷新图层列表Call RefreshList(cboLayerName, LayerList)'选择图层列表中的第一个实体If cboLayerName.ListIndex = -1 Then cboLayerName.ListIndex = 0End IfEnd Sub'获得图形中存在的图层列表Private Function GetLayerList() As Collection Dim objLayer As AcadLayerDim LayerList As New CollectionSet objDoc = ThisDrawing.Application.ActiveDocument '获得可用的图层For Each objLayer In yersLayerList.Add , Next'返回图形中块参照的列表Set GetLayerList = LayerListEnd Function' 显示AutoCAD中当前可用的图块Public Sub ListBlock()Dim BlockReferenceList As Collection'获得图形中存在的块参照列表Set BlockReferenceList = GetBlockReferences()'判断是否存在块参照If BlockReferenceList Is Nothing ThenMsgBox "当前图形中不存在任何的块！", vbExclamation Exit SubEnd If'刷新块参照列表Call RefreshList(cboBlockName, BlockReferenceList)'选择块参照列表中的第一个实体If cboBlockName.ListIndex = -1 Then cboBlockName.ListIndex = 0End If。
只需1分钟，就能够帮你搞定全公司所有人桌签，非常简单
只需1分钟，就能够帮你搞定全公司所有人桌签，非常简单
老板：小王，等下要开会，你把要参加会议的所有人的桌签做一下，5分钟过后就要给到我！
小王：五分钟什么怎么可能呦！
不用担心啦！下面教大家一招只需1分钟就能够帮你搞定全公司所有人桌签非常简单，感兴趣的朋友不妨来学习一下！
制作步骤：
1、首先我们准备好一份Excel表格，将参会人员名单全部录入进去！
2、再新建一份Word文档，插入一个【文本框】选择绘制横排文本框，将文本框高度设置为10厘米
3、再选中文本框，右击鼠标选中【设置形状格式】，将填充改成【无填充】，将线条改成【无线条】，接着单击【文本选项】-【文本框】，将垂直对齐方式选择【中部对齐】
4、然后点击菜单栏'邮件'，找到【选择收件人】-【使用现有列表】
5、接着点击【编写和插入域】-【插入合并域】-【参会人员】
6、选中Word里面的《参会人员》，设置字号为100，居中文本，
7、按住CTRL+SHIFT键拖动然后单击【对齐】选中【垂直居中】
8、再选中第一个【文本框】，单击【旋转】-【垂直翻转】
9、完成后我们点击【邮件】-【完成并合并】-【编辑单个文档】-【全部】即可搞定啦！
有没有学会呢？暂时没看懂的朋友也没关系，点击收藏一下，等你制作时候按照步骤从头开始就可以啦！，步骤下面有详细的动图操作便于理解参考！。
Excel之VBA常用功能应用篇：用VBA在EXCEL里实现标签的批量打印
Excel之VBA常用功能应用篇：用VBA在EXCEL里实现标签的批量打印相信很多小伙伴曾经也跟我一样遇到类似的问题：如何让一些数据能够自动填充到指定栏并自动打印出来，类似的实现方式比如邮件合并啊，虚拟打印啊，有好几种，今天我给大家介绍如何用vba来实现。
事情的起因是需要打一批产品标签，大家知道标签格式都是固定的，但是每一件毛重净重会有微小的变化，如果靠人工来改一个打一张，实在效率低下，那我的目标就是做一个简单vba来循环，填充数据-》打印-》填充下一列数据-》打印。
那怎么来实现呢？下面我教大家一步步来。
A。
首先，我们要在excel里开启vba功能，这个默认是关闭的，因为vba本身是个程序，以前曾经很流行vba病毒。
下面的步骤是我百度复制来的，如果看不懂的盆友可以直接百度经验。
1，打开Excel软件，点击左上角的文件菜单2，选择左下角的选项菜单3，选择自动以功能区的开发工具4，点击顶部的开发工具菜单5，点击Visual Basic按钮6，这样就打开了VBA的编辑区域B。
好了，vba我们先放一放，我们先把标签页和数据页建立起来。
图3然后按自己需要的格式编辑好，我自己的弄完以后大概是这个样子，那个红色格子都是醒目作用，打印的时候是不需要的哈图4所有我标红色的格子，都是需要自动更新数据的地方，下面重要部分来了大家注意看！我们需要用一个函数来实现这个功能，否则第一步自动更新数据我们就做不下去了，对不对。
记住这个函数，offset，这个函数根据引用的数据来做参照计算，比如其中有个L6-2，这个什么意思呢，引用L2栏内的数据来做计算图5比如图4中，L6栏的序号是124，这个意思就是我需要引用数据页中第124行的数据来填充到这个标签内，而在=OFFSET(数据页!$A$2,L6-2,5)这个函数内，数据页!$A$2表示引用数据页这个sheet中的数据，L6-2则表示引用哪一行，最后一个5表示这一行中的第几个数据。
利用VBA实现自动排列打印考试座次表
用ＶＢＡ实现自动排列、打印考试座次表考试是学校考查教师教学效果，教师了解学生学习情况，从而提高教学质量的一项常规工作，也是国家选拔人才的重要手段。
编排考试座次表这种简单重复的工作，以前考务人员采用复制、粘贴的手段来编排、打印，耗费了大量时间和精力。
本人利用ＶＢＡ制作的这个软件，能自动编排打印考试座次表，从而轻松完成上述工作，为你节约大量的时间和精力。
一、准备工作１、在Ｅxcel中建立一个有５张工作表的工作薄，将其名称分别改为：考生名单、４０人顺序打印、按３０人首尾相连、按４０人首尾相连、按５０人首尾相连；２、将“考生名单”工作表按如图１格式建好，要求：第一行为标题，第一列存放考号数据，第二列存放班次数据，第三列为姓名，以后各列可有可无，然后按考号（或班次或总分等）排好顺序。
３、将工作表“４０顺序打印”、“按３０人首尾相连”、“按４０人首尾相连”、“按５０人首尾相连”分别按图２、图３、图４、图５格式建好。
其中标题文字、行列的宽高、字体、字型、字号等可按自己的需要作相应的改动。
图１二、编写ＶＢＡ代码１、按“４０人顺序打印”代码在“４０人顺序打印”工作表中添加一个“按钮”控件，在“指定宏”窗口中将宏名改为“４０人顺序打印”，单击新建，然后在代码窗口中输入以下头代码：Sub 按40人打印()Dim ipage As Integer, page As Integer, line As Integer, x As Integer,y as Integer, icount As IntegerApplication.ScreenUpdating = Trueicount = Sheets("考生名单").[a1].CurrentRegion.Rows.Count – 1 //统计考生人数If icount / 40 = Int(icount / 40) Then //计算考室数ipage = icount / 40Elseipage = Int(icount / 40) + 1End IfSheets("40人顺序打印").SelectFor page = 0 To ipage – 1 //为1至最后考室编排座次Cells(1, 10) = page + 1 //在第一行第十列填写考室序号line = page * 40 + 2 //在”考生名单”中查找本考室第一列第一名考生For x = 4 To 11 //为4至11行填写数据For y=1 to 19 //为每一行中1至9列中不被4整除的列填写考号、班次、姓名if y/4<>int(y/4) thencells(x,y)=Sheets("考生名单").Cells(line+(int(y/4)*8),y-int(y/4)*4) //将”考生名单”中”考号”、“班次”、End If //“姓名”填入座次表相应座位中Next yline = line + 1 //考生下移一位Next xSheets("40人顺序打印").PrintOut //打印本考室座次表Next pageEnd Sub图２２、“按３０人首尾相连”打印代码操作如前“４０人顺序打印”，代码如下（部分语句注解同前）：Sub 按30人首尾相连()Dim ipage As Integer, page As Integer, line As Integer, x As Integer, y As Integer,icount As IntegerApplication.ScreenUpdating = Trueicount = Sheets("考生名单").[a1].CurrentRegion.Rows.Count - 1If icount / 30 = Int(icount / 30) Thenipage = icount / 30Elseipage = Int(icount / 30) + 1End IfSheets("按30人首尾相连").SelectFor page = 0 To ipage - 1Cells(1, 8) = page + 1line = page * 30 + 2 //查找第一列第一位考生For x = 4 To 11 //填写考室第一列考生数据For y= 1 to 3 //填写本列每一考生数据Cells(x, y) = Sheets("考生名单").Cells(line, y)Next yline = line + 1 //考生下移一位Next xline = page * 30 + 16 //查找第二列第一位考生For x = 5 To 11 //填写考室第二列考生数据For y = 5 To 7 //填写本列每一考生数据Cells(x, y) = Sheets("考生名单").Cells(line, y - 4)Next yline = line – 1 //考生前移一位Next xline = page * 30 + 17 //查找第三列第一位考生For x = 5 To 11 //填写考室第三列考生数据For y = 9 To 11Cells(x, y) = Sheets("考生名单").Cells(line, y - 8)Next yline = line + 1 //考生下移一位Next xline = page * 30 + 31 //查找第四列第一位考生For x = 4 To 11 //填写考室第四列考生数据For y = 13 To 15Cells(x, y) = Sheets("考生名单").Cells(line, y - 12)Next yline = line – 1 / /考生前移一位Next xSheets("按30人首尾相连").PrintOutNext pageEnd Sub图３３、“按４０人首尾相连”打印代码操作如前“４０人顺序打印”，代码如下（部分语句注解同前）：Sub 按40人首尾相连()Dim ipage As Integer, page As Integer, line As Integer, x As Integer, y As Integer, icount As IntegerApplication.ScreenUpdating = Trueicount = Sheets("考生名单").[a1].CurrentRegion.Rows.Count - 1If icount / 40 = Int(icount / 40) Thenipage = icount / 40Elseipage = Int(icount / 40) + 1End IfSheets("按40人首尾相连").SelectFor page = 0 To ipage - 1Cells(1, 10) = page + 1line = page * 40 + 2For y = 1 To 5For x = 4 To 11If y / 2 <> Int(y / 2) Then //排列奇数列考生数据，下面三行语也可采用一个循环语句实现Cells(x, (y - 1) * 4 + 1) = Sheets("考生名单").Cells(line + (y - 1) * 8, 1)Cells(x, (y - 1) * 4 + 2) = Sheets("考生名单").Cells(line + (y - 1) * 8, 2)Cells(x, (y - 1) * 4 + 3) = Sheets("考生名单").Cells(line + (y - 1) * 8, 3)line = line + 1Else //填写偶数列考生数据Cells(x, (y - 1) * 4 + 1) = Sheets("考生名单").Cells(line + (y - 1) * 8 - 1, 1)Cells(x, (y - 1) * 4 + 2) = Sheets("考生名单").Cells(line + (y - 1) * 8 - 1, 2)Cells(x, (y - 1) * 4 + 3) = Sheets("考生名单").Cells(line + (y - 1) * 8 - 1, 3)line = line - 1End IfNext xNext ySheets("按40人首尾相连").PrintOutNext pageEnd Sub图４４、“按５０人首尾相连”打印代码操作如前“４０人顺序打印”，代码如下（部分语句注解同前）：Sub 按50人首尾相连()Dim ipage As Integer, page As Integer, line As Integer, x As Integer, y As Integer, icount As Integer Application.ScreenUpdating = Trueicount = Sheets("考生名单").[a1].CurrentRegion.Rows.Count - 1If icount / 50 = Int(icount / 50) Thenipage = icount / 50Elseipage = Int(icount / 50) + 1End IfSheets("按50人首尾相连").SelectFor page = 0 To ipage - 1Cells(1, 9) = page + 1line = page * 50 + 2For y = 1 To 5For x = 4 To 13If y / 2 <> Int(y / 2) ThenCells(x, (y - 1) * 4 + 1) = Sheets("考生名单").Cells(line + (y - 1) * 10, 1)Cells(x, (y - 1) * 4 + 2) = Sheets("考生名单").Cells(line + (y - 1) * 10, 2)Cells(x, (y - 1) * 4 + 3) = Sheets("考生名单").Cells(line + (y - 1) * 10, 3)line = line + 1ElseCells(x, (y - 1) * 4 + 1) = Sheets("考生名单").Cells(line + (y - 1) * 10 - 1, 1)Cells(x, (y - 1) * 4 + 2) = Sheets("考生名单").Cells(line + (y - 1) * 10 - 1, 2)Cells(x, (y - 1) * 4 + 3) = Sheets("考生名单").Cells(line + (y - 1) * 10 - 1, 3)line = line - 1End IfNext xNext ySheets("按50人首尾相连").PrintOutNext pageEnd Sub图５以上几种编排方案已基本上满足各种考试的需要，如有其它格式的需要，只需参考上面代码作相应改动即可，相信它定能为你的工作带来极大的方便。
Excel批量生成、打印考场座签
巧用Excel批量生成和打印考场座位标签马上就是各个学校期中考试的时间了。
为了使各类考试的组织工作能顺利地进行，让考生顺利地找到自己的考场座位坐下来安静待考是非常重要的。
这其中打印考场座位标签成为一项必不可少的工作。
许多朋友都是用Excel进行考务管理工作的，那如何利用Excel来实现批量座位标签的打印呢?为了方便给大家介绍，接下来笔者以4个班级的考生数据为例介绍下实现的过程。
考生名册的生成根据座位标签中需要打印的项目，笔者设计了“考生名册”工作表。
为了体现考试的公平，大家可事先将考生按班级号“1～4”循环的顺序整理好，“座位号”也可根据考场的大小设计成“1~30”的循环号，即每个考场30个考生。
考场座位标签报表的设计考场座位标签的设计要本着美观、实用、节省纸张和便于剪裁的原则，结合实际使用的经验，笔者在一张A4的打印纸上设计了30个座位标签(1行3个，共10行，如下图)。
报表的设计工作在“桌贴”工作表中进行。
开始时可先设计一个座位标签，然后对该标签中要调用的数据进行反复测试。
调用数据的方法是(以第1个考生的座位标签为例)，在第1个考生的“准考证号” 所在的B3单元格内输入公式“=INDIRECT(“考生名册!A”&CEILING((ROW()-1)/4，1)*3-2+CEILING(COLUMN()/5，1)-1+($P$2-1)*30+2)”便得到了该考生的准考证号。
公式中的INDIRECT函数的功能是用于返回指定单元格内的引用(即“考生名册”工作表A3单元格中的准考证号);公式中的“CEILING((ROW()-1)/4，1)*3-2+CEILING(COLUMN()/5，1)-1+($P$2-1)*30+2”得到的数值为“3”，使用该公式的目的在于指定该考生标签所在单元格区域(“A2：E5”，即4行5列)内返回的都是同一个数字，这样做是为了在其余的“姓名”、“班级”、“考场”和“座号”等单元格中用相同的函数实现对该考生数据的调用，这一功能主要是通过CEILING函数来实现的，该函数的功能是将指定的数值向上舍入为最接近的整数。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
用Excel和VBA轻松实现桌签批量打印
用Excel来制作桌面标签（以下简称桌签）确实是一个比较新颖的方法，不过要是同时制作很多桌签也还是比较费时的。
那么今天笔者就介绍一种用VBA轻松实现桌签批量打印的方法。
一、准备工作
⒈启动Excel2003(其他单元格也可以)，执行“工具→自定义”命令，打开“自定义”对话框。
在“命令”标签中，选中“类别”下面的“工具”选项，然后在“命令”下面找到“照相机”选项，并将它拖到工具栏合适位置上。
⒉在Sheet1工作表中(最好将文档取名保存一下)，仿照图1的样式，在B列相应的单元格中输入需要打印桌签的名称，并在A1中输入一个名称。
⒊在C1单元格(也可以是其他单元格)中输入公式:=COUNTA(B:B)，用于统计所要打印的桌签数目。
⒋选中A1单元格，设置字符居中对齐，并设置一种适合用作桌签的字体(如魏碑体)。
二、制作桌签
⒈选中A1单元格，单击一下工具栏上的“照相机”按钮，再切换到“Sheet2”工作表中，单击一下鼠标，即可得到一张A1单元格的照片
小贴士:这种照片不同于普通图片，它与A1单元格中的数据建立了链接，随A1单元格中的字符改变而改变。
⒉选中“照片”，执行“格式→图片”命令，打开“设置图片格式”对话框，在“颜色与线条”标签中，将“线条”设置为“无线条颜色”，点击“确定”返回。
⒊根据桌签底座的尺寸，将“照片”调整至合适大小，并将它定位到页面合适位置上。
⒋将上述“照片”复制一份，在“设置图片格式”对话框的“大小”标签中，将它“旋转→180°”，并将它定位到页面合适位置上(效果参见图2)。
三、编制宏程序
⒈按下“Alt+F11”组合键，打开“Visual Basic编辑器”(图3)，在右侧的“工程资源管理器”区域中，选中“VBAProject(桌签.xls)”选项，执行“插入→模块”命令，插入一个模块(模块1)。
⒉双击“模块1”，展开右侧的代码编辑区，将下述代码输入其中:Sub 桌签() '建立一个名称为“桌签”的宏。
For i = 1 To Sheet1.Cells(1, 3) '设立一个循环:开始值为1，结束值为Sheet1工作表C3单元格内的值(即桌签数目)。
Sheet1.Select '选中Sheet1工作表。
Cells(1, 1).V alue = Cells(i, 2).V alue '依次将B列的桌签字符调入A1单元格中。
Columns("A:A").Select '选中A列。
Selection.Columns.AutoFit '将A列设置为“最合适的列宽”，这样让字符不同的桌签自动适应“照片”的大小。
Sheet2.Select '选中Sheet2工作表。
ActiveWindow.SelectedSheets.PrintOut'执行一下打印操作，打印出一张桌签。
Next '进入下一个循环。
Sheet1.Select '桌签全部打印完成后，选中Sheet1工作表。
Range("B1").Select '选中B1单元格，等待下一次修改字符。
ActiveWorkbook.Save '保存当前工作簿文档。
Application.Quit '退出Excel。
End Sub '宏的结束符号。
小贴士:①上述代码中英文单引号及其后面的字符是对代码的注释，可以不输入。
②宏的结束符号上面的4行代码不输入不影响桌签的打印。
⒊输入完成后，关闭“Visual Basic编辑器”窗口。
四、添加按钮
⒈切换到Sheet1工作表中，执行“视图→工具栏→窗体”命令，展开“窗体”工具栏，单击工具栏上的“按钮”按钮，在工作表中拖拉出一个按钮，此时系统弹出“指定宏”对话框(图4)，选中刚才编制的“桌签”宏，确定返回。
2.将按钮上的文字修改为“打印桌签”，再调整好大小，并定位在工作表合适位置上(参见图1)。
以后需要打印桌签时，只要将相应的字符输入到B列下面的单元格中，然后按下“打印桌签”按钮，就一切OK了。