用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实现自动排列打印考试座次表
用VBA实现自动排列、打印考试座次表考试是学校考查教师教学效果,教师了解学生学习情况,从而提高教学质量的一项常规工作,也是国家选拔人才的重要手段。
编排考试座次表这种简单重复的工作,以前考务人员采用复制、粘贴的手段来编排、打印,耗费了大量时间和精力。
本人利用VBA制作的这个软件,能自动编排打印考试座次表,从而轻松完成上述工作,为你节约大量的时间和精力。
一、准备工作1、在Excel中建立一个有5张工作表的工作薄,将其名称分别改为:考生名单、40人顺序打印、按30人首尾相连、按40人首尾相连、按50人首尾相连;2、将“考生名单”工作表按如图1格式建好,要求:第一行为标题,第一列存放考号数据,第二列存放班次数据,第三列为姓名,以后各列可有可无,然后按考号(或班次或总分等)排好顺序。
3、将工作表“40顺序打印”、“按30人首尾相连”、“按40人首尾相连”、“按50人首尾相连”分别按图2、图3、图4、图5格式建好。
其中标题文字、行列的宽高、字体、字型、字号等可按自己的需要作相应的改动。
图1二、编写VBA代码1、按“40人顺序打印”代码在“40人顺序打印”工作表中添加一个“按钮”控件,在“指定宏”窗口中将宏名改为“40人顺序打印”,单击新建,然后在代码窗口中输入以下头代码: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图22、“按30人首尾相连”打印代码操作如前“40人顺序打印”,代码如下(部分语句注解同前):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图33、“按40人首尾相连”打印代码操作如前“40人顺序打印”,代码如下(部分语句注解同前):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图44、“按50人首尾相连”打印代码操作如前“40人顺序打印”,代码如下(部分语句注解同前):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图5以上几种编排方案已基本上满足各种考试的需要,如有其它格式的需要,只需参考上面代码作相应改动即可,相信它定能为你的工作带来极大的方便。
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函数来实现的,该函数的功能是将指定的数值向上舍入为最接近的整数。
巧用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函数来实现的,该函数的功能是将指定的数值向上舍入为最接近的整数。
接下来就可以用相同的公式来调用该考生的“姓名”、“班级”、“考场”和“座号”等单元格中的数据了,只需将原来公式中的指定的A列分别改为“B”、“C”、“D”和“E”列就可以了。
如何用Excel VBA批量打印文件
如何用Excel VBA批量打印文件有时候一个文件夹内有很多Excel文件,几十个,上百个,如果一个个的打开,然后再打印,显然重复劳动,效率低下。
能不能用Excel VBA批量打印同一文件夹内的所有文件?答案当然是肯定的。
假设我们的桌面上有个名叫“材料”的文件夹,内有上百个EXCEL文件需要打印打开EXCEL文件→Visual Basic编辑器(Alt+F11)→插入→模块以下是VBA代码********************************************************************* **Sub test()Set rrr = CreateObject("Scripting.FileSystemObject")Set r = rrr.GetFolder("C:\Documents and Settings\Administrator\桌面\材料")For Each i In r.FilesWorkbooks.Open Filename:=("C:\Documents and Settings\Administrator\桌面\材料\" + + "")ActiveSheet.PageSetup.PrintArea = ""ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=TrueActiveWindow.Close saveChanges:=FalseNextEnd Sub********************************************************************* **************注释:ActiveSheet.PageSetup.PrintArea = "" 的目的是“取消打印区域”因为有时候这些excel文件并不是我们自己写得,可能已经被别人设定好了打印区域,并保存在文件中,这是我们所看不到的。
用VBA实现批量复制和打印任务
2 系统 设计
21 程 序 设 计 的 主 要 思 路 .
假 设此 工 作 是 用 手 工操 作 的话 . 比如 从 第 2行 记 录 打 印 到
为 了描 述 方 便 ,笔 者将 含有 数据 的表 格 ( 2 图 )命 名 为 数
据 表 ,其 工 作 表 标 签 为 d t ,将 要 打 印 的 “ 工 基本 情 况 登 记 a a 员
要 求 把 图 1中 的 数 据 按 照 图 2 “ 工 基 本 情 况 登 记 表 ” 员 的 格 式 填 写 完 整 并 打 印 输 出 。 按 照 常 规 的 方 法 ,把 第 一 个 人 的 信 息 依 次 复 制 到 要 打 印 的 表 格 中 .然 后 打 印 ,再 复 制 下 一 个 人 员 ,依 此 类 推 如 果 单 位 有 1 0 2 0多 人 ,要 都 按 照 这 个 方 法 来 进 行 , 那 会 很 繁 琐 ,复 制 数 据 过 程 中 ,也 容 易 ( )根 据 员 工 姓 名 打 印 某 一 条 记 录 ,如 打 印 姓 名 为 “ 3 尉
第 1 记 录 ,那 么 操 作 过 程 应该 是这 样 的 :把 数 据 表 中 的 A 0行 2
单 元 格 中 的 “ 俟 ” 复制 到登 记表 中 的 C 万 2单 元 格 中 ,把 数 据
表 中的 B 2复 制 到 登 记 表 中 的 E ,依 此 类 推 ,直 至 把 “ 俟 ” 2 万 的工 作 简历 复制 到 登 记 表 中对 应 的 B 1 元 格 中 ,数据 复制 完 1单 成 后 ,打 印输 出 .这 样 就完 成 了第 2行 记 录 的 操 作 ,接 下来 复
批量打印的VBA程序
批量打印的VBA程序批量打印的VBA程序一项任务的要求是把表1按照表2填写完整后,打印输出。
如果人多的话,这项工作很是繁琐,所以我写了一个VBA程序,让工作自动进行。
后来,这个程序的思路还发表的论文。
Option ExplicitDim Arr() '定义要打印的记录的行号为可变数组,用来保存要打印的记录的行号Dim LastRow%, PrePage%, FindNameRow% '定义数据表中的最后一行行号、向导在第二步时的页面、找到的姓名所在的行Dim OutToPrint As Boolean '定义是否输出到打印机Private Sub CBcancel_Click()Unload MeEnd SubPrivate Sub CBfinish_Click()Dim i%, j%Dim myadd()UFPrint.Hidemyadd = Array("C2", "E2", "G2", "C3", "E3", "G3", "C4", "C5", "F5", "C6", "C7", "E7", "C8", "E8", "C9", "E9", "G9", "C10", "E10", "G10", "B11")' 定义需输入内容的单元格地址为数组For i = LBound(Arr) To UBound(Arr) ' 循环提取数据表中需要处理的记录For j = LBound(myadd) To UBound(myadd) ' 循环提取各字段数据Sheets("print").Range(myadd(j)).Value = Sheets("data").Cells(Arr(i), j + 1).Value' 将数据填入到表格中Next jIf OutToPrint Then Sheets("print").PrintOut ' 打印If Not OutToPrint Then Sheets("print").PrintPreview '打印预览DoEventsNextUFPrint.MultiPage1.Value = 0 '到第一个页面UFPrint.ShowEnd SubPrivate Sub CBnext_Click()Dim i%, SelCount%, MyCount%, ChangePage%Select Case MultiPage1.Value '判断按下“下一步”按钮时的页面Case 0 '第一个页面If OptionButton1.Value = True Then ChangePage = 1If OptionButton2.Value = True Then ChangePage = 2If OptionButton3.Value = True Then ChangePage = 3'根据所做的选择,分别设置将要跳到哪一个页面Case 1 '第二个页面If Val(TextBox1) < 2 Or Val(TextBox1) > LastRow Or Val(TextBox2) < 2 OrVal(TextBox2) > LastRow ThenMsgBox "数值应大于等于2,小于等于" & LastRow, vbOKOnly + vbExclamation, "提示"TextBox1 = 2TextBox2 = 2Exit SubEnd If'如果数据不符合要求,退出过程ReDim Arr(CInt(TextBox1) To CInt(TextBox2)) '重新定义数组For i = LBound(Arr) To UBound(Arr)Arr(i) = iNext i'将数据写入数组ChangePage = 4 '设置要转到的下一个页面Case 2 '第三个页面SelCount = 0For i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) Then SelCount = SelCount + 1Next i'得到共有多少条记录被选择ReDim Arr(1 To SelCount) '重新定义数组MyCount = 1For i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) ThenArr(MyCount) = CInt(ListBox1.List(i, 0))MyCount = MyCount + 1End IfNext i'将数据写入数组ChangePage = 4 '设置要转到的下一个页面Case 3 '第四个页面Call CommandButton2_Click '调用“查找”,确定能否找到记录If FindNameRow = 0 Then '不能找到记录MsgBox "找不到姓名为<" & TextBox3 & ">的记录,<下一步>按钮不起作用!", vbOKOnly + vbExclamation, "错误提示"Exit Sub '退出过程End IfReDim Arr(1 To 1) '重新定义数组Arr(1) = FindNameRowChangePage = 4 '设置要转到的下一个页面End SelectMultiPage1.Value = ChangePage '切换页面End SubPrivate Sub CBpre_Click()Dim ChangePage%Select Case MultiPage1.ValueCase 1, 2, 3ChangePage = 0Case 4ChangePage = PrePage '读取前一页的信息End SelectMultiPage1.Value = ChangePageEnd SubPrivate Sub CommandButton2_Click()Dim i%FindNameRow = 0For i = 2 To LastRowIf Sheets("data").Cells(i, 1) = TextBox3.Text Then FindNameRow = iExit ForEnd IfNext iIf FindNameRow = 0 ThenLabel9.Caption = "未找到记录,请修改姓名后再试" CBnext.Enabled = FalseElseLabel9.Caption = "可以找到记录,请继续下一步" CBnext.Enabled = TrueEnd IfEnd SubDim i%Dim MyStep$Select Case MultiPage1.ValueCase 0CBpre.Enabled = FalseCBnext.Enabled = TrueCBfinish.Enabled = FalseMyStep = "一"Case 1CBpre.Enabled = TrueCBnext.Enabled = TrueCBfinish.Enabled = FalsePrePage = 1MyStep = "二"Case 2'重新加载listbox1中的数据ListBox1.Clear '清除列表框中的原有内容For i = 2 To LastRowListBox1.AddItem iListBox1.List(i - 2, 1) = Sheets("data").Cells(i, 1) '在列表框的第二列中添加姓名Next iListBox1.Selected(0) = True '将第一条记录设置为选择状态CBpre.Enabled = TrueCBnext.Enabled = TrueCBfinish.Enabled = FalsePrePage = 2MyStep = "二"Case 3CBnext.Enabled = IIf(Left(Label9.Caption, 1) = "可", True, False)CBpre.Enabled = TrueCBfinish.Enabled = FalsePrePage = 3MyStep = "二"Case 4CBpre.Enabled = TrueCBnext.Enabled = FalseCBfinish.Enabled = TrueMyStep = "三"End SelectUFPrint.Caption = "批量打印信息收集向导---第" & MyStep & "步,共三步" '更改窗体的题目End SubOutToPrint = FalseEnd SubPrivate Sub OptionButton5_Click()OutToPrint = TrueEnd SubPrivate Sub SpinButton1_Change()TextBox1.Text = SpinButton1.ValueEnd SubPrivate Sub SpinButton2_Change()TextBox2.Text = SpinButton2.ValueEnd SubPrivate Sub UserForm_Initialize()LastRow = Sheets("data").Range("A65536").End(xlUp).Row '获得数据表中的记录数 MultiPage1.Style = fmTabStyleNone '将页面标签设置为无MultiPage1.Value = 0 '设置第一个页面打开CBfinish.Enabled = False '禁用“完成”按钮CBpre.Enabled = False '禁用“上一条”按钮OptionButton1.Value = True '第一页上“连续的记录”被选中OptionButton4.Value = True '第五页上“打印预览”被选中SpinButton1.Max = LastRow '设置旋转按钮的最大值SpinButton2.Max = LastRow '同上End Sub。
【方法与技巧】批量打印台签(座位牌)事半功倍的奇效
【方法与技巧】批量打印台签(座位牌)事半功倍的奇效
前两天公司开会,来了80多号人。
一听说都要打印台签(座位牌),文员一直抓狂,复制粘贴打印,然后再复制粘贴打印(重复了80多次),忙了将近一个小时,终于把80多个台签(座位牌)做好。
后来她和我聊天时说到这个事情,我跟她说,这个工作其实简单的点几下鼠标就完成了,快的话1分钟就能搞定~~她不是很相信,于是我操作了一遍给她看~~然后,她再次抓狂。
今天就在这里把这个方法分享给大家。
首先我们需要准备两个东西,一个台签(座位牌)的word模板,一个含有与会名单的excel文档。
如下图所示。
下面开始具体的操作。
1.打开台签(座位牌)word模板,点击“邮件”选项卡,再点击“选择收件人”,然后选择“使用现有列表”
2.在弹出的窗口中选择含有与会名单的excel文档,点击“打开”
3.在新弹出的窗口中选择名单具体在哪个sheet里,然后“确定”,此时excel中的数据已经连接到word文档(表面上看不出任何变化)
4.把光标移到word文档中需要输入名字的地方,选择“邮件”选项卡下的“插入合并域”,里面就有我们之前做的与会名单excel文档的表头,我们在这里选择“姓名”。
5.选择插入的“姓名”代码,直接修改其文字格式,此格式即为最终打印出来的格式。
6.格式设置完毕后,点击“邮件”选项卡下的“完成并合并”,选择“编辑单个文档”,然后直接点“确定”
7.此时会弹出一个新的word文档,有没有很激动,台签(座位牌)批量生成完毕!!直接保存或打印!!
有了这个方法,就算来1000个名单也照样1分钟搞定!。
用Excel和VBA轻松实现桌签批量打印
用Excel和VBA轻松实现桌签批量打印作者:陈秀峰用Excel来制作桌面标签(以下简称桌签)确实是一个比较新颖的方法,不过要是同时制作很多桌签也还是比较费时的。
那么今天笔者就介绍一种用VBA轻松实现桌签批量打印的方法。
一、准备工作⒈启动Excel2003(其他单元格也可以),执行“工具→自定义”命令,打开“自定义”对话框。
在“命令”标签中,选中“类别”下面的“工具”选项,然后在“命令”下面找到“照相机”选项,并将它拖到工具栏合适位置上。
⒉在Sheet1工作表中(最好将文档取名保存一下),仿照图1的样式,在B列相应的单元格中输入需要打印桌签的名称,并在A1中输入一个名称。
图1⒊在C1单元格(也可以是其他单元格)中输入公式:=COUNTA(B:B),用于统计所要打印的桌签数目。
⒋选中A1单元格,设置字符居中对齐,并设置一种适合用作桌签的字体(如魏碑体)。
二、制作桌签⒈选中A1单元格,单击一下工具栏上的“照相机”按钮,再切换到“Sheet2”工作表中,单击一下鼠标,即可得到一张A1单元格的照片(图2)。
图2小贴士:这种照片不同于普通图片,它与A1单元格中的数据建立了链接,随A1单元格中的字符改变而改变。
⒉选中“照片”,执行“格式→图片”命令,打开“设置图片格式”对话框,在“颜色与线条”标签中,将“线条”设置为“无线条颜色”,点击“确定”返回。
⒊根据桌签底座的尺寸,将“照片”调整至合适大小,并将它定位到页面合适位置上。
⒋将上述“照片”复制一份,在“设置图片格式”对话框的“大小”标签中,将它“旋转→180°”,并将它定位到页面合适位置上(效果参见图2)。
三、编制宏程序⒈按下“Alt+F11”组合键,打开“Visual Basic编辑器”(图3),在右侧的“工程资源管理器”区域中,选中“VBA PR oject(桌签.xls)”选项,执行“插入→模块”命令,插入一个模块(模块1)。
图4⒉双击“模块1”,展开右侧的代码编辑区,将下述代码输入其中:Sub 桌签() '建立一个名称为“桌签”的宏。
使用Excel表格制作的商品标签模板,可以实现批量连续打印
使用Excel表格制作的商品标签模板,可以实现批量连续打印
两年前,我在库管易网站发表过一份批量制作标签的表格,其中运用了窗体实现单张及批量打印。
但发现实际运用不如函数灵活与容易操作,以下为我更新后的标签模板Excel表格;
我按超市的商品标签制作的,大家可以在此基础上,进行修改编辑。
可以制作实际工作中的成品标签、物料标签、货架标签等,使用简单、修改也简单。
此表格模板,只要输入对应物料的序号,即可实现查询、打印预览、单张打印、批量打印等功能。
一、标签模板
标签模板运用了函数,请不要清除,打印按钮运用了VBA代码,没有加密,大家可以查看代码并修改。
在批量连续打印时,当输入结束序号后,公式会自动计算出总计需要打印多少张标签。
批量打印前,请先检查打印纸张是否充足、是否需要添加纸张的温馨提示,避免打印途中断纸的麻烦。
二、商品清单
当需要新增商品物料时,请按此格式录入相关商品信息,查询打印时,模板界面会自动同步更新。
序号列设定了公式,当B列输入内容后,A列会自动添加对应的
序号,删除行没有影响。
当增加行后,请把公式下拉复制即可。
三、表格下载
以下为标签模板表格,打印运用到了宏命令,在使用EXCEL表格时请启用宏,欢迎大家下载使用!。
Excel全自动会议桌签,双面桌牌自动打印,A4格式万能套用
Excel全自动会议桌签,双面桌牌自动打印,A4格式万能套用
大家请看范例图片,会议室座签,桌牌,双面打印,会议室会场布置专用。
一般是有色彩纸打印,对折套用。
今天介绍Excl排版设计,A4打印。
下方输入内容,上方文字自动显示。
大家可以根据自身亚克力大小调整行高,列宽。
CTRL+P直接打印。
对于多人打印座签,我们进入工作表2,批量输入姓名。
直接点击控件打印按钮,批量打印,无需打一张,换一张名字,极大简化工作难度。
VBA代码无密码,方便小伙伴学习,开发~。
~简单工作从这一刻开始。
ExcelVBA编程与宏自动打印如何设定宏的自动打印和批量打印
ExcelVBA编程与宏自动打印如何设定宏的自动打印和批量打印Excel VBA编程与宏自动打印如何设定宏的自动打印和批量打印Microsoft Excel是广泛使用的电子表格软件之一,而借助Excel的VBA编程和宏功能,用户可以轻松自动化各种重复性任务,比如自动打印和批量打印文档。
本文将介绍如何使用Excel VBA编程和宏来设置自动打印和批量打印的功能。
自动打印是指在特定条件下,Excel会自动执行打印操作,而不需要用户手动操作。
一般情况下,用户可以设置特定的条件,比如在保存文件时自动打印、在工作表被更新时自动打印等。
下面是设定宏的自动打印的步骤:第一步,打开Excel软件并进入“开发工具”选项卡。
如果你的Excel 软件没有显示“开发工具”选项卡,你需要先进行设置。
在Excel中,点击“文件”选项卡,在弹出的菜单中选择“选项”,然后在弹出的选项对话框中点击“自定义功能区”。
在右侧的菜单栏中勾选“开发工具”,最后点击“确定”按钮完成设置。
第二步,点击“开发工具”选项卡中的“Visual Basic”按钮,进入VBA 编辑器环境。
第三步,进入VBA编辑器后,你需要创建一个宏。
在VBA编辑器的左侧“项目资源管理器”窗口中,右键点击任意一个项目,然后选择“插入”->“模块”。
在弹出的模块窗口中,你可以输入VBA代码来编写宏。
第四步,编写宏的代码。
在VBA编辑器的右侧窗口中,你可以编写自己的VBA代码实现自动打印的功能。
比如,你可以使用以下的VBA代码来实现在保存时自动打印的功能:```Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)'设置自动打印的代码ActiveSheet.PrintOutEnd Sub```在这个例子中,我们使用了Workbook_BeforeSave事件来在保存文件时触发打印操作。
VBA中的打印设置与批量打印技巧
VBA中的打印设置与批量打印技巧在Excel中,我们常常需要对工作表进行打印,打印设置的灵活性和批量打印的效率对于提高工作效率非常重要。
VBA (Visual Basic for Applications) 是一种可以在Microsoft Office套件中的各个应用程序中使用的编程语言,能够帮助我们自动化处理任务,包括打印设置和批量打印。
本文将介绍VBA中常用的打印设置以及一些实用的批量打印技巧,帮助您提高工作效率。
1. 打印设置VBA中的打印设置功能丰富,可以根据需求自定义打印页面、页眉页脚、打印区域等。
1.1 打印页面设置使用VBA,您可以轻松地对打印页面进行设置。
例如,您可以设置纸张大小、方向、边距等。
```vbaSub 页面设置()With ActiveSheet.PageSetup.PaperSize = xlPaperA4 ' 设置纸张大小为A4.Orientation = xlLandscape ' 设置横向打印.LeftMargin = Application.InchesToPoints(0.5) ' 设置左边距为0.5英寸.RightMargin = Application.InchesToPoints(0.5) ' 设置右边距为0.5英寸.TopMargin = Application.InchesToPoints(0.75) ' 设置上边距为0.75英寸.BottomMargin = Application.InchesToPoints(0.75) ' 设置下边距为0.75英寸 End WithEnd Sub```1.2 设置页眉页脚通过VBA,您可以在打印时添加页眉页脚,为打印内容提供更多信息。
```vbaSub 页眉页脚设置()With ActiveSheet.PageSetup.LeftHeader = "左侧页眉" ' 设置左侧页眉.CenterHeader = "中间页眉" ' 设置中间页眉.RightHeader = "右侧页眉" ' 设置右侧页眉.LeftFooter = "左侧页脚" ' 设置左侧页脚.CenterFooter = "中间页脚" ' 设置中间页脚.RightFooter = "右侧页脚" ' 设置右侧页脚End WithEnd Sub```1.3 打印区域设置有时候,我们不需要将整个工作表都打印出来,而只希望打印某个特定的区域。
VBA中的文件打印和批量打印方法介绍
VBA中的文件打印和批量打印方法介绍VBA是一种用于Microsoft Office应用程序的编程语言,它可以帮助用户更有效地处理和管理数据。
在VBA中,文件打印和批量打印是常见的任务,本文将介绍如何使用VBA中的方法来实现这些功能。
一、文件打印方法介绍VBA中的文件打印方法允许用户通过编程方式控制打印操作,可以选择性地打印特定的文档,设置打印选项以及指定打印份数等。
1. 使用PrintOut方法打印当前活动文档在VBA中,可以使用PrintOut方法来打印当前活动的文档。
以下是一个示例代码:```Sub PrintActiveDocument()ActiveDocument.PrintOutEnd Sub```通过运行上述代码,VBA会自动打印当前活动的文档。
2. 使用PrintOut方法打印指定的文档如果想要打印指定的文档,可以使用PrintOut方法,并指定要打印的文档对象。
以下是一个示例代码:```Sub PrintSpecificDocument()Dim doc As ObjectSet doc = Documents.Open("C:\Documents\Sample.docx")doc.PrintOutdoc.Close SaveChanges:=FalseEnd Sub```上述代码中,首先通过Documents.Open方法打开要打印的文档,然后使用doc.PrintOut方法打印该文档。
最后,使用doc.Close方法关闭文档,并选择不保存更改。
3. 设置打印选项VBA中的文件打印方法还支持设置打印选项,如打印份数、打印范围、纸张类型等。
以下是一个示例代码:```Sub SetPrintOptions()ActiveDocument.PrintOut Copies:=2, Range:=wdPrintFromTo, Pages:="1-3", _Item:=wdPrintDocumentWithMarkup, PaperSize:=wdPaperA4 End Sub```上述代码中,通过传递不同的参数值给PrintOut方法,可以设置打印选项。
- 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).Value = Cells(i, 2).Value '依次将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了。