4.5.2-代码解析：L1_Sub_生成个人档案

该过程实现的功能如下：

1）对员工的姓名进行循环遍历

2）将每名员工的姓名作为参数传到下一个函数

3）将以上函数的返回值写入到首页每名员工对应的C列，提示在生成档案过程有没有遇到问题

代码如下

1   Sub L1_Sub_生成个人档案()

2       Set shtFirst = ThisWorkbook.Worksheets("操作界面")

3       maxRow = shtFirst.Cells(Rows.Count, "B").End(xlUp).Row

4       If maxRow > 2 Then

5           For i = 3 To maxRow Step 1

6               employeeName = shtFirst.Cells(i, "B")

7               If employeeName <> "" Then

8                   tips = "正在生成个人档案：" & employeeName

9                   Debug.Print (tips)

10                  returnTips = L11_Fun_createPersonalFile(employeeName)

11                  shtFirst.Cells(i, "C") = returnTips

12              End If

13              

14          Next i

15      Else

16          MsgBox "请输入员工姓名"

17      End If

18  End Sub

代码中文解析

1   Sub L1_Sub_生成个人档案()

2       定义工作表shtFirst，表示操作界面工作表

3       获取shtFirst工作表B列的最大非空行maxRow

4       判断开始：如果maxRow大于2成立

5           循环开始：i从3开始，每次循环加1，直到i=maxRow

6               设置员工姓名为shtFirst的第i行第B列

7               判断开始：如果员工姓名不为空条件成立

8                   设置变量tips为"正在生成个人档案：员工姓名"，其中员工姓名每次循环从i行B列获取 

9                   在VBE的立即窗口显示变量tips的取值

10                  执行函数L11_Fun_createPersonalFile，并将员工姓名为作为传递参数，函数返回值为returnTips

11                  shtFirst工作表第i行第C列输入变量returnTips的取值

12              判断结束

13              

14          循环结束

15      其它：

16          弹窗显示"请输入员工姓名"

17      判断结束

18  End Sub

关键代码解读

1）第4行： If maxRow > 2 Then。在循环前需要判断用户是否有输入员工姓名到B列，我们在写代码的过程中，需要考虑到用户可能的不规范操作，从代码上兼容这些操作，也就是所谓代码的鲁棒性。

2）第8行： tips = "正在生成个人档案：" & employeeName。字符串的连接使用&。当字符串在不同条件下显示的结果不一样，需要将其中的变化部分定义成变量的形式，使用&连接字符串的常量及变量部分。

3）第10行： returnTips = L11_Fun_createPersonalFile(employeeName)。调用Sub时，我们采用Call Sub名称，对于无返回值的Function，也可以使用Call 函数名的方式。对于需要使用函数返回值的时候，将函数赋值给一个变量即可，该变量的取值即为函数的返回值。

4.5.3-代码解析：L11_Fun_createPersonalFile

该函数实现的功能如下：

1）根据员工的姓名复制模板文件，生成个人档案文件

2）对个人档案文件更新以下五类信息，每一类更新采用一个函数或者过程实现

2.1）人员信息更新，包含籍贯、毕业院校等

2.2）考核成绩更新

2.3）证书信息更新

2.4）获奖信息

2.5）员工照片

代码如下

1   Function L11_Fun_createPersonalFile(employeeName)

2       Application.DisplayAlerts = False

3       

4       currentPath = ThisWorkbook.Path

5       folderAddress = currentPath & "\" & "个人档案"

6       newFileName = employeeName & ".xlsx"

7       

8       newFileAddress = folderAddress & "\" & newFileName

9       ' 检查文件是否已经存在，存在则删除

10      If Dir(newFileAddress) <> "" Then

11          Kill newFileAddress

12      End If

13      

14      templateFile = "个人档案模板.xlsx"

15      templateFileAddress = currentPath & "\" & templateFile

16      FileCopy templateFileAddress, newFileAddress

17      

18      Set wb = Workbooks.Open(newFileAddress)

19      Set shtOutput = wb.Worksheets(1)

20      

21      ' 填入信息

22      shtOutput.Range("D2") = employeeName

23      shtOutput.Range("F1") = Now()

24      

25      tips1 = L111_Fun_人员信息(shtOutput, employeeName)

26      tips2 = L112_Fun_考核成绩(shtOutput, employeeName)

27      Call L113_Sub_证书(shtOutput, employeeName)

28      Call L114_Sub_获奖(shtOutput, employeeName)

29      Call L115_Sub_员工照片(shtOutput, employeeName)

30      

31      wb.Save

32      wb.Close

33      

34      returnTips = tips1 & ";" & tips2

35      

36      L11_Fun_createPersonalFile = returnTips

37  End Function

代码中文解析

1   Function L11_Fun_createPersonalFile(employeeName)  '传入参数employeeName

2       关闭警告信息

3       

4       获取当前文件所在绝对地址currentPath

5       获取当前文件夹下子文件夹"个人档案"的地址，对应变量名为folderAddress

6       设定新生成的员工个人档案文件命名为员工姓名.xlsx，对应变量名为newFileName

7       

8       拟打算将新生成的个人档案文件放置于"个人档案"文件夹下，其绝对地址为newFileAddress

9       ' 注释

10      判断开始：判断员工个人档案文件是否已经存在，如果是则执行以下语句

11          删除已有员工个人档案

12      判断结束

13      

14      默认文件名称为templateFile

15      默认文件地址为templateFileAddress

16      文件复制，复制模板文件到"个人档案"文件夹下，命名为newFileAddress

17      

18      设置wb表示打开的新生成的员工档案Excel文件

19      获取该工作簿的第1个工作表，表示为shtOutput

20      

21      ' 注释

22      在员工个人档案工作表shtOutput的"D2"单元格写入员工姓名employeeName

23      在员工个人档案工作表shtOutput的"F1"单元格写入当前时间

24      

25      设置tips1为函数 L111_Fun_人员信息(shtOutput, employeeName) 的返回值

26      设置tips2为函数 L112_Fun_考核成绩(shtOutput, employeeName) 的返回值

27      调用过程 L113_Sub_证书(shtOutput, employeeName)

28      调用过程 L114_Sub_获奖(shtOutput, employeeName)

29      调用过程 L115_Sub_员工照片(shtOutput, employeeName)

30      

31      保存员工个人档案工作簿wb

32      关闭员工个人档案工作簿wb

33      

34      将tips1与tips2以";"连接起来，并赋值给returnTips

35      

36      设置函数返回值为returnTips

37  End Function

经过以上文章的多次每行的解读，相信大家对VBA的基础使用应该有了一个初步的认识，后续的文章不再逐句进行中文的解析，只对关键语句进行中文解析

关键代码解读

1）第2行： Application.DisplayAlerts = False。关闭警告，当我们去掉该句，或者改为True。当执行到wb.Save时，会弹窗提示，如图4-16所示，需要人为关闭该弹框。这样当我们批量生成员工档案的时候就会很麻烦。

2）第31行： wb.Save。保存Excel文件，对新生成的Excel文件填写相关信息后务必保存，否则一波操作全浪费。

3）第36行： L11_Fun_createPersonalFile = returnTips。变量returnTips赋值给函数名，表示该函数的返回值为returnTips。当整个函数内部没有任何变量或者值赋值给函数名，那么这个函数不返回任何值，若设置X=函数()，在本地窗口查看X的值，为空值，类型为Empty，如图4-17所示。

---

图4-17 函数返回值

4.5.4-代码解析：L111_Fun_人员信息

该函数的功能是从人员信息工作表中寻找当前人员的信息，人员信息表结构如图4-18所示。可知人员信息表，每名员工有一行信息，只需要找到该员工所处的行号就可以获取员工信息，将这些信息写入新生成的员工档案表即可，效果如图4-19所示。核心代码逻辑如下：

• 1）根据姓名，寻找该名员工信息所在行号

• 2）根据行号，获取该员工的籍贯、毕业院校、专业、手机号、通讯地址、学历信息

• 3）将以上信息按照固定位置写入生成员工个人档案表中

---

图4-18 人员信息表

---

图4-19 人员档案中的人员信息

---

代码如下

1   Function L111_Fun_人员信息(shtOutput, employeeName)

2       ' 从人员信息表中获取基础信息

3       Set shtPerson = ThisWorkbook.Worksheets("人员信息")

4       Set shtRng = shtPerson.Range("B:B")

5       pos = Application.Match(employeeName, shtRng, 0)

6       

7       If IsError(pos) Then

8           returnTips = "未找到人员基础信息"

9       Else

10          birthPlace = shtPerson.Cells(pos, "C")

11          school = shtPerson.Cells(pos, "D")

12          major = shtPerson.Cells(pos, "E")

13          cellphone = shtPerson.Cells(pos, "F")

14          contactAddress = shtPerson.Cells(pos, "G")

15          academicCredentials = shtPerson.Cells(pos, "H")

16          

17          shtOutput.Range("F2") = birthPlace

18          shtOutput.Range("D3") = school

19          shtOutput.Range("F3") = major

20          shtOutput.Range("D4") = cellphone

21          shtOutput.Range("F4") = academicCredentials

22          shtOutput.Range("D5") = contactAddress

23          

24          returnTips = "人员信息已找到"

25      End If

26      

27      L111_Fun_人员信息 = returnTips

28  End Function

关键代码解读

1）第5行：pos = Application.Match(employeeName, shtRng, 0)。获取该员工在员工信息工作表所在的行数。这里的0表示精确匹配，就是必须一模一样。这里的Application不能省略，若省略会报错，如图4-20所示。Application表示该函数为工作表函数，在Excel表中可以直接使用该公式，如图4-21所示。在VBA中存在一些这样特别的函数，只需要使用时加上Application即可。

图4-20 省略Application报错

---

图4-21 match函数在Excel公式中的应用

2）第7行：IsError(pos)，判断pos是否是错误信息。图4-22示例中，采用match函数未找到需要的信息时，返回一个错误信息Error 2042。用IsError来识别这个错误，如果没有考虑这种可能，程序运行就会报错，我们不希望这种程序出错出现。在我们写程序的时候，尽量考虑可能发生的所有情况，提高代码的健壮性。在本示例中，存在几种可能导致没有查找到该员工信息，一是该员工信息没有提前录入到人员信息工作表，二是操作界面输入的员工姓名写错了。这种情况下，应该给使用该系统的人员提示，而不是程序错误无法使用。

图4-22 macth未找到匹配信息

4.5.5-代码解析：L112_Fun_考核成绩

该函数的功能是从考核成绩中获取该员工的成绩，因为存在多次考核结果，所以需要遍历该工作表，找到每一个成绩，逐一写入到生成的员工档案中。代码核心逻辑如下：

1）清空员工档案模板中的原数据

2）对考核成绩工作表进行循环，找到该员工的成绩

3）设置一个初始列号，每写入一个信息，列号+1，确保信息逐一写入

代码如下

1   Function L112_Fun_考核成绩(shtOutput, employeeName)

2       ' 清空原数据

3       shtOutput.Range("J10:O11").ClearContents

4       

5       Set sht = ThisWorkbook.Worksheets("考核成绩")

6       maxRow = sht.Cells(Rows.Count, "B").End(xlUp).Row

7       

8       col = 10

9       flag = 0

10      For i = 2 To maxRow Step 1

11          employeeNameDB = sht.Cells(i, "B")

12          If employeeNameDB = employeeName Then

13              yearInfo = sht.Cells(i, "C")

14              noteInfo = sht.Cells(i, "D")

15              

16              shtOutput.Cells(10, col) = yearInfo

17              shtOutput.Cells(11, col) = noteInfo

18              

19              col = col + 1

20              

21              flag = 1

22          End If

23      Next i

24      

25      If flag = 1 Then

26          returnTips = "找到人员考核成绩"

27      Else

28          returnTips = "未找到人员考核成绩"

29      End If

30      

31      L112_Fun_考核成绩 = returnTips

32      

33  End Function

关键代码解读

1）第8行：col = 10。这部分目标是为显示图4-23的柱状图，柱状图的数据区域是J10-O12，只需要更新这部分数据即可。也就是说数据是从第10列（J列）开始录入的，所以在这里我们设置了一个初始值，每增加一个新的值列号+1，第19行实现了这部分功能，col = col + 1。其实在本示例中假设柱状图关联的数据范围是固定的，也就是说如果有多次考核成绩，超过J10-O12区域，那么超过的区域是无法在柱状图中显示的，这个跟想要的显然有一段差距。这里我们就需要新增一个功能，就是动态变化柱状图关联的单元格区域。这一部分功能在后续再介绍。

2）第9行，flag = 0。我们查找某员工的考核成绩时，有一种可能是该员工可能刚入职，没有考核成绩，所以需要一个标识符flag，告知是否至少找到一个考核成绩。第21行，flag = 1，告诉后续环节找到了一个成绩。后续只需通过判断flag的值就可以区分是否有考核成绩被找到。

---

图4-23 考核成绩柱状图显示

4.5.6-代码解析：L113_Sub_证书

该Sub的功能就是获取员工的证书信息，其实整体方法和上一节类似，只是在写入员工档案时需要写在特定区域，并且按照从左至右，从上向下的顺序，如图4-24所示。这种需求在填写获奖信息部分也是一样的，只是开始结束行不一样，所以将这一部分功能写成一个单独的过程L1131_Sub_writeToRng。

---

图4-24 证书和获奖信息

---

代码如下

1   Sub L113_Sub_证书(shtOutput, employeeName)

2       Set sht = ThisWorkbook.Worksheets("证书信息")

3       maxRow = sht.Cells(Rows.Count, "B").End(xlUp).Row

4       

5       startRow = 24

6       endRow = 27

7       startCol = 2

8       endCol = 6

9       

10      For i = 2 To maxRow Step 1

11          employeeNameDB = sht.Cells(i, "B")

12          If employeeNameDB = employeeName Then

13              certificate = sht.Cells(i, "C")

14              Call L1131_Sub_writeToRng(certificate, shtOutput, startRow, endRow, startCol, endCol)

15              

16          End If

17      Next i

18      

19  End Sub

按照从左到右，从上到下写入信息。基本逻辑如下：

1）设置标识符flag，表示是否将信息成功写入

2）两个循环：外层循环，对行循环；内层循环，对列循环。通过这两个循环实现从左到右，从上到下依次写入信息

3）行循环中，先判断标识符flag信息，判断是否已经成功写入，若已经写入，则退出循环

4）列循环中，先判断被循环单元格是否为空，若为空，则写入拟写入的信息，并将flag设置为1

1   Sub L1131_Sub_writeToRng(inputSth, shtOutput, startRow, endRow, startCol, endCol)

2       flag = 0

3       

4       For i = startRow To endRow Step 1

5           If flag = 1 Then

6               Exit For

7           End If

8           

9           For j = startCol To endCol Step 1

10              inputCell = shtOutput.Cells(i, j)

11              If inputCell = "" Then

12                  shtOutput.Cells(i, j) = inputSth

13                  flag = 1

14                  Exit For

15              End If

16              

17          Next j

18      Next i

19  End Sub

关键代码解读

1）第6行：Exit For。退出最近一层For循环，从该行代码向上找，找到的第一个For循环，退出该For循环。

过程L114_Sub_获奖代码与L113_Sub_证书基本类似，就不单独讲解了

4.5.7-代码解析：L115_Sub_员工照片

该过程的目标就是在员工档案中A2-B8区域插入照片信息。首先我们需要在模板中将该区域的所有行设置同样的高度，列设置成同样的宽度，另外我们需要提前将照片放在一个固定的文件夹中，且以员工姓名来命名对应的照片文件。代码逻辑如下：

1）获取该员工照片地址信息

2）判断员工照片是否存在

3）加入一个矩形框，矩形框的宽度为A2单元格的2倍，高度为7倍，也就是A2-B8区域

4）对矩形框进行图片填充，填充的图片即为员工的照片

对于插入图片那一段代码第9行-第22行，可以通过录制宏的模式先生成，再更改部分代码即可。

代码如下

1   Sub L115_Sub_员工照片(shtOutput, employeeName)

2       currentPath = ThisWorkbook.Path

3       folderAddress = currentPath & "\" & "图片库"

4       photoName = employeeName & ".png"

5       photoAddress = folderAddress & "\" & photoName

6       

7       If Dir(photoAddress) <> "" Then

8           'msoShapeRectangle是类别，是一个矩形

9           shtOutput.Shapes.AddShape(msoShapeRectangle, _

10          shtOutput.Range("A2").Left, _

11          shtOutput.Range("B2").Top, _

12          shtOutput.Range("A2").Width * 2, _

13          shtOutput.Range("A2").Height * 7).Select

14      

15          Selection.ShapeRange.Fill.Visible = msoFalse

16          Selection.ShapeRange.Line.Visible = msoTrue

17      

18          With Selection.ShapeRange.Fill

19              .Visible = msoTrue

20              .UserPicture photoAddress

21              .TextureTile = msoFalse

22          End With

23      End If

24  End Sub

关键代码解读

1）第9-13行：shtOutput.Shapes.AddShape(msoShapeRectangle，最左侧位置，最上侧位置，宽度，高度)。最左侧位置使用A2单元格位置，最上侧位置使用B2单元格位置（这里使用A2也是一样的），宽度为A2的2倍，高度为7倍。在这里也说明了为什么刚开始将这个区域的高度宽度设置成一致的原因。该方法如果在其它地方用，核心需要修改的为第10-13，表示拟加入图片单元格区域的信息，以及第20行，表示填充图片的地址

4.6-本章小结

本章使用一个示例展示了以下知识点，回顾一下是否都已经掌握了，如果没有，不妨回看一下：

1）Function函数的使用

2）对其它Excel文件的操作：复制，打开，关闭，写入等

3）文件及文件夹的一些操作

4）报警信息关闭

5）查找信息：Match，for循环

6）在Excel特定单元格区域插入图片

回顾一下，好像也没有很难的知识点，其实一般Excel自动化工作，需要涉及的知识点是非常少的，一般包括如下：

1）整体架构上，设置不同步骤，对应不同Sub或者Function

2）单个Sub或者Function中，掌握循环、判断结构

3）Excel操作中的信息查找

4）Excel读写

5）使用一些可以简化工作的内置函数