《在Excel中批量合并带照片证卡.doc》由会员分享，可在线阅读，更多相关《在Excel中批量合并带照片证卡.doc（8页珍藏版）》请在金锄头文库上搜索。
1、在Excel中通过VBA实现批量打印带照片证卡中国矿业大学管理学院 苏丁摘要 Microsoft公司的Office系列办公软件因为其功能强大、界面友好以及操作简单等优点而成为大多数用电脑办公人员的首选工具。多数人都知道，在Excel中输入数据然后在Word中通过其邮件合并功能调用Excel中输入的数据可以方便地批量打印出信封、标签以及名片等。而对于胸牌、准考证等需要照片证卡的做法往往是先打印出文字部分然后手工粘贴照片，这种做法不但浪费人力、物力、财力而且容易出错。数码照相机、彩色打印机及相关设备的普及运用为照片随同文字一起合并打印提供了物质基础。由于Word2003不支持将Excel2003单
2、元格中照片直接合并，本文将详细介绍在Excel2003中通过VBA实现批量合并、排版、打印带照片证卡的具体做法。关键词 EXCEL VBA一、问题的提出笔者在单位主要负责职工培训、考评工作，通常情况下每个月要组织数百名职工参加各种类型的培训。每次培训，开始时要为参加培训的每位学员做听课证，结束时要为每位学员做准考证，对于考核合格的职工要发该类培训的合格证。更早期的不谈，在计算机普及应用之后，笔者所在单位做上述各类证件的通常做法是：在Microsoft的Excel中输入参加培训每位职工的具体信息，如姓名、单位、培训专业、时间等，然后利用Microsoft的Word中提供的邮件合并功能调用Exce
3、l中输入的数据，从而实现批量排版、打印的目的。对于需要粘贴照片的证卡，通常的做法是在排版时预留好一照片大小的方框，在组织参培职工统一照相之后，用手工的方式逐一将每位参培人员的照片粘贴于预留好的方框内。实践表明，这种做法与早期纯手工时代的做法相比先进许多，但仍然存在很多问题。通常问题是参培职工的照片不能一次拍摄就符合要求，即使符合要求，在裁剪及粘贴过程中经常出现人为损坏及张冠李戴的现象。就算每一步工序都不出差错，从照片的拍摄、冲洗、裁剪、查找对应到最后的粘贴仍要耗费大量的人力、物力与财力。随着数码照相机、彩色打印机及相关设备的普及运用，将各类证件上的相片连同文字一起合并、排版、打印的需求被提出来
4、。测试表明， Microsoft Word中的邮件合并功能不支持将Excel中插入的照片直接合并到Word文档中（即使支持，在Excel中逐一插入照片也非常麻烦）。考虑到本部门职工对Microsoft Office系列软件比较熟悉，转用其它各类专业软件的成本过高，因而决定在Excel中实现这一功能。经过反复调试，在Excel中利用VBA成功地实现了各类带照片证卡批量合并、排版及打印目的。下面以在Excel2003中利用VBA批量制作准考证为例，详细介绍这一过程的具体做法。二、相关知识背景Excel2003是Microsoft公司的Office2003系列办公软件成员之一，是目前应用最为广泛的办
5、公室表格处理软件之一。Excel2003提供直观快捷的数据输入、强大灵活的数据处理、丰富的图表制作、完善的报表、快速统计分析功能，几乎办公人员没有不用到EXCEL的。但如果我们只满足于手工操作这些功能，那我们处理一些重复的工作时就会象机器人一样机械的操作。值得庆幸的是Microsoft公司的Office的专家们为大家想到了一个方法，那就是把VBA（VisualBasicApplication（简称VBA）嵌套在Office中。VBA是Microsoft面向最终用户的应用软件编程语言。它最早出现于Microsoft的Excel和Project中，如今VBA已成为VB和所有Office产品的组件。
6、另外，越来越多的软件开发商购买了VBA语言的使用权，如常用的绘图软件AutoCAD等均已支持VBA作为二次开发工具。VBA语言简单易学，但功能却不寻常，其运行效率对于普通的应用也完全能满足需要。一般而言，利用VBA可以做到：定制和扩展客户应用程序功能；将客户应用程序及数据集成到其他应用程序中。在Excel中，记录宏把需要用户重复的工作自动化，这其实已经是对Excel的定制，但它仅仅是定制或扩展Excel的开端。因为，系统自动记录的宏虽然常常罗列了一大堆代码，但真正有用的却很少，且没有嵌入错误处理方案。而利用VBA定制Excel刚克服了上述的不足。三、实例-批量制作准考证以学员姓名为文件名保存其
7、照片与任意目录，系统默认照片目录为当前目录下pics目录中。打开Excel2003，重命名两个工作表分别为：jf、sd。在工作表jf中输入学员基本信息，在工作表sd中按需要排版好准考证格式。如图1、2、3所示：图1 照片默认保存位置图2 工作表jf中输入学员信息图3 工作表sd中排版好空白准考证 VBA实现原理：首先检查工作表组中是否有名称为sdjf的工作表，如果有先删除，否则直接插入新工作表并重新命名为sdjf。选择jf工作表，从第一条数据记录开始循环：先从sd工作表中将空白准考证拷贝到sdjf工作表的第一行，然后从jf工作表中指定单元格对其有关字段进行赋值，并按姓名从指定的目录中插入照片。
8、完毕后进入jf工作表中下一条记录开始新一轮循环。 具体操作如下： 按Alt+F11调出VB编辑器，右击左侧窗口中VBAProject插入一用户窗体，在窗体中添加一命令按钮，对命令按钮的click事件编写代码如下：Option ExplicitPrivate Sub CommandButton1_Click()On Error GoTo errordealApplication.DisplayAlerts = False 系统不提示删除工作表前的确认 Dim ans 检查工作表sdjf是否存在，如果存在先删除Dim j As IntegerFor j = 1 To Worksheets.coun
9、t If InStr(1, Worksheets(j).Name, sdjf) 0 Then Sheets(Worksheets(j).Name).Select ActiveWindow.SelectedSheets.Delete Exit For End IfNext j在工作表jf前插入一工作表，并重新命名为sdjfWorksheets.Add Before:=Worksheets(jf)For j = 1 To Worksheets.count If InStr(1, Worksheets(j).Name, Sheet) 0 Then Sheets(Worksheets(j).Name)
10、.SelectSheets(Worksheets(j).Name).Name = sdjfExit For End IfNext j 在sdjf工作表中设定准考证各列宽度 Sheets(sdjf).Select Columns(A:A).Select Selection.ColumnWidth = 4.5 Columns(B:B).Select Selection.ColumnWidth = 15.5 Columns(C:C).Select Selection.ColumnWidth = 12.5 Columns(D:D).Select Selection.ColumnWidth = 4 Co
11、lumns(E:E).Select Selection.ColumnWidth = 4.5 Columns(F:F).Select Selection.ColumnWidth = 15.5 Columns(G:G).Select Selection.ColumnWidth = 12.5 Columns(H:H).Select Selection.ColumnWidth = 1 Dim i As Integer i = 2 对jf工作表中数据滚动，从第二行开始至第一列没有数据结束 Do While Len(Trim(Worksheets(jf).Cells(i, 1).Value) 0 从sd工
12、作表中复制空白准考证 dim lefttop as string lefttop = A & Trim(Str(4 * i - 7) 要复制空表左上角位置 Sheets(sd).Select Range(A1:G8).Select Selection.Copy Sheets(sdjf).Select Range(lefttop).Select ActiveSheet.Paste 对空白准考证各字段赋值 Worksheets(sdjf).Cells(4 * i - 5, 2).Value = Worksheets(jf).Cells(i, 1).Value Worksheets(sdjf).Ce
13、lls(4 * i - 4, 2).Value = Worksheets(jf).Cells(i, 2).Value Worksheets(sdjf).Cells(4 * i - 3, 2).Value = Worksheets(jf).Cells(i, 5).Value Worksheets(sdjf).Cells(4 * i - 2, 2).Value = Worksheets(jf).Cells(i, 4).Value Worksheets(sdjf).Cells(4 * i - 1, 2).Value = Worksheets(jf).Cells(i, 3).Value 对指定位置插入
14、图片 Dim picpath As String picpath = ActiveWorkbook.Path & pics & Trim(Worksheets(jf).Cells(i, 3).Value) & .jpg 图片路径 Dim pictopleft As String pictopleft = C & Trim(Str(4 * i - 5) & :C & Trim(Str(4 * i - 1) Range(pictopleft).Select ActiveSheet.Pictures.Insert(picpath).Select 一行内排两个准考证,以下雷同 对空白准考证各字段赋值 Worksheets(sdjf).Cells(4 * i - 5, 6).Value = Worksheets(jf).Cells(i + 1, 1).Value Worksheets(sdjf).Cells(4 * i - 4, 6).Value = Worksheets(jf).Cells(i + 1, 2).Value
