|
4.1-项目介绍 4.2-项目架构 4.2.1-系统可见部分 4.2.2-项目代码逻辑 4.3-代码 4.4-看代码前的几个基础知识 4.4.1-函数Function 4.4.2-弹窗提示 4.4.3-文件或者文件夹是否存在 4.4.4-文件操作：复制、删除、重命名 4.4.5-跳出循环或函数或过程 4.5-本章示例代码详解 4.5.1-代码结构解析 4.5.2-代码解析：L1_Sub_生成个人档案 4.5.3-代码解析：L11_Fun_createPersonalFile 4.5.4-代码解析：L111_Fun_人员信息 4.5.5-代码解析：L112_Fun_考核成绩 4.5.6-代码解析：L113_Sub_证书 4.5.7-代码解析：L115_Sub_员工照片 4.6-本章小结 4.1-项目介绍引言 本章依然采用一个小项目的方式，介绍新的知识点。本章介绍的知识点如下：
某公司的员工信息记录在一个Excel文件中，分成多个表来记录：人员信息、考核成绩、证书信息、获奖信息四个工作表，如图4-1所示。现有一个需求就是获取每一个人的个人档案，涵盖以上信息加上个人照片，个人档案的Excel模板如图4-2所示。
4.2-项目架构 4.2.1-系统可见部分 4.2.2-项目代码逻辑 4.2.1-系统可见部分将原档案文件另存为个人档案批量生成.xlsm，增加操作界面工作表，整体布局如图4-3所示。
该项目所处文件夹做了简单的规范化管理，如图4-4所示。一个项目建议放在一个文件夹下，清晰明了。该项目包括以下信息： 1）文件夹：个人档案，最后生成的Excel文件存放的位置 2）文件夹：图片库，个人的照片信息存放的位置 3）文件：个人档案模板.xlsx，模板文件 4）文件：个人档案批量生成.xlsm，数据、操作界面及代码存在的文件
4.2.2-项目代码逻辑 如操作界面所显示的，整个代码逻辑如下： 1）从操作界面获取拟输出员工姓名，可以是一个也可以是多个，理论上不限数目 2）以员工姓名复制模板文件，命名为员工姓名.xlsx文件 3）写入时间信息 4）从代码所在Excel文件不同工作表中获取该员工的相关信息，写入新生成的Excel文件中 5）根据员工姓名插入文件名为员工姓名.png的图片到指定位置，控制其高度为7A2，宽度为7A2，A2表示A2单元格 6）返回结果写入操作界面C列 4.3-代码初学者，建议将以下代码打印出来，拿出笔一行一行去看，当然后文我也是一行一行解读的 Sub L1_Sub_生成个人档案() Set shtFirst = ThisWorkbook.Worksheets("操作界面") maxRow = shtFirst.Cells(Rows.Count, "B").End(xlUp).Row If maxRow > 2 Then For i = 3 To maxRow Step 1 employeeName = shtFirst.Cells(i, "B") If employeeName <> "" Then tips = "正在生成个人档案：" & employeeName Debug.Print (tips) returnTips = L11_Fun_createPersonalFile(employeeName) shtFirst.Cells(i, "C") = returnTips End If Next i Else MsgBox "请输入员工姓名" End If End Sub Function L11_Fun_createPersonalFile(employeeName) Application.DisplayAlerts = False currentPath = ThisWorkbook.Path folderAddress = currentPath & "\" & "个人档案" newFileName = employeeName & ".xlsx" newFileAddress = folderAddress & "\" & newFileName ' 检查文件是否已经存在，存在则删除 If Dir(newFileAddress) <> "" Then Kill newFileAddress End If templateFile = "个人档案模板.xlsx" templateFileAddress = currentPath & "\" & templateFile FileCopy templateFileAddress, newFileAddress Set wb = Workbooks.Open(newFileAddress) Set shtOutput = wb.Worksheets(1) ' 填入信息 shtOutput.Range("D2") = employeeName shtOutput.Range("F1") = Now() tips1 = L111_Fun_人员信息(shtOutput, employeeName) tips2 = L112_Fun_考核成绩(shtOutput, employeeName) Call L113_Sub_证书(shtOutput, employeeName) Call L114_Sub_获奖(shtOutput, employeeName) Call L115_Sub_员工照片(shtOutput, employeeName) wb.Save wb.Close returnTips = tips1 & ";" & tips2 L11_Fun_createPersonalFile = returnTips End Function Function L111_Fun_人员信息(shtOutput, employeeName) ' 从人员信息表中获取基础信息 Set shtPerson = ThisWorkbook.Worksheets("人员信息") Set shtRng = shtPerson.Range("B:B") pos = Application.Match(employeeName, shtRng, 0) If IsError(pos) Then returnTips = "未找到人员基础信息" Else birthPlace = shtPerson.Cells(pos, "C") school = shtPerson.Cells(pos, "D") major = shtPerson.Cells(pos, "E") cellphone = shtPerson.Cells(pos, "F") contactAddress = shtPerson.Cells(pos, "G") academicCredentials = shtPerson.Cells(pos, "H") shtOutput.Range("F2") = birthPlace shtOutput.Range("D3") = school shtOutput.Range("F3") = major shtOutput.Range("D4") = cellphone shtOutput.Range("F4") = academicCredentials shtOutput.Range("D5") = contactAddress returnTips = "人员信息已找到" End If L111_Fun_人员信息 = returnTips End Function Function L112_Fun_考核成绩(shtOutput, employeeName) ' 清空原数据 shtOutput.Range("J10:O11").ClearContents Set sht = ThisWorkbook.Worksheets("考核成绩") maxRow = sht.Cells(Rows.Count, "B").End(xlUp).Row col = 10 flag = 0 For i = 2 To maxRow Step 1 employeeNameDB = sht.Cells(i, "B") If employeeNameDB = employeeName Then yearInfo = sht.Cells(i, "C") noteInfo = sht.Cells(i, "D") shtOutput.Cells(10, col) = yearInfo shtOutput.Cells(11, col) = noteInfo col = col + 1 flag = 1 End If Next i If flag = 1 Then returnTips = "找到人员考核成绩" Else returnTips = "未找到人员考核成绩" End If L112_Fun_考核成绩 = returnTips End Function Sub L113_Sub_证书(shtOutput, employeeName) Set sht = ThisWorkbook.Worksheets("证书信息") maxRow = sht.Cells(Rows.Count, "B").End(xlUp).Row startRow = 24 endRow = 27 startCol = 2 endCol = 6 For i = 2 To maxRow Step 1 employeeNameDB = sht.Cells(i, "B") If employeeNameDB = employeeName Then certificate = sht.Cells(i, "C") Call L1131_Sub_writeToRng(certificate, shtOutput, startRow, endRow, startCol, endCol) End If Next i End Sub Sub L114_Sub_获奖(shtOutput, employeeName) Set sht = ThisWorkbook.Worksheets("获奖信息") maxRow = sht.Cells(Rows.Count, "B").End(xlUp).Row startRow = 17 endRow = 21 startCol = 2 endCol = 6 For i = 2 To maxRow Step 1 employeeNameDB = sht.Cells(i, "B") If employeeNameDB = employeeName Then certificate = sht.Cells(i, "C") Call L1131_Sub_writeToRng(certificate, shtOutput, startRow, endRow, startCol, endCol) End If Next i End Sub Sub L1131_Sub_writeToRng(inputSth, shtOutput, startRow, endRow, startCol, endCol) flag = 0 For i = startRow To endRow Step 1 If flag = 1 Then Exit For End If For j = startCol To endCol Step 1 inputCell = shtOutput.Cells(i, j) If inputCell = "" Then shtOutput.Cells(i, j) = inputSth flag = 1 Exit For End If Next j Next i End Sub Sub L115_Sub_员工照片(shtOutput, employeeName) currentPath = ThisWorkbook.Path folderAddress = currentPath & "\" & "图片库" photoName = employeeName & ".png" photoAddress = folderAddress & "\" & photoName If Dir(photoAddress) <> "" Then 'msoShapeRectangle是类别，是一个矩形 shtOutput.Shapes.AddShape(msoShapeRectangle, _ shtOutput.Range("A2").Left, _ shtOutput.Range("B2").Top, _ shtOutput.Range("A2").Width * 2, _ shtOutput.Range("A2").Height * 7).Select Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Line.Visible = msoTrue With Selection.ShapeRange.Fill .Visible = msoTrue .UserPicture photoAddress .TextureTile = msoFalse End With End If End Sub 以上代码写在一个模块中，涉及到3个Function和5个Sub。为了便于区别，每个过程或者函数的名称中包含了过程Sub或者函数Fun的区分。简单理解的话，当我们需要返回一个信息时使用Function，如果只是执行一段特定功能的代码，无需返回值，使用Sub即可。 做了一段测试，同样的功能分别使用 Sub和 Function实现，同样采用Call Sub名称/函数名称的方式实现，从结果上来看没有什么区别。
4.4-看代码前的几个基础知识 4.4.1-函数Function 4.4.2-弹窗提示 4.4.3-文件或者文件夹是否存在 4.4.4-文件操作：复制、删除、重命名 4.4.5-跳出循环或函数或过程 4.4.1-函数Function 从代码的文本角度来说，Function与Sub区别就是使用的关键字不同。Function与我们在数学上学的函数概念基本是一致的，以下示例的函数实现两个数相加的效果，输出结果为3。函数最终的输出结果通过将拟输出的信息赋值给函数名，在下面的示例中为y。若函数无返回值，也可以使用Call 函数名。除了有返回值，Function的使用方法与Sub并无不同，至少一般使用中没有。 Sub test() x1 = 1 x2 = 2 output = y(x1, x2) Debug.Print (output) End Sub Function y(x1, x2) y = x1 + x2 End Function 4.4.2-弹窗提示 在需要一些交互或者提示用户信息时，可以使用弹框。如果只是简单的提示，使用 Msgbox 拟弹框信息即可，注意空格的使用。Msgbox也可以支持其它的功能，以下6句Msgbox执行结果如图4-6至4-10所示，注意弹窗的区别及对应代码的区别。 Sub test2() MsgBox "test" MsgBox "test", vbCritical, "弹窗" MsgBox "test", vbInformation, "弹窗" x = MsgBox("test", vbYesNoCancel, "弹窗") Debug.Print (x) x1 = MsgBox("test", vbYesNo, "弹窗") Debug.Print (x1) End Sub
对于vbYesNoCancel，vbYesNo用户选择不同时返回的值是不同的，通过返回值得知用户的选择，一般用于需要用户进行选择的程序代码中。大家有没有发现，在VBA中很多场景下空格代替()中的作用。 4.4.3-文件或者文件夹是否存在 我们对文件或者文件夹进行读写等操作前，需要先判断是否存在，也就是说无法对一个不存在的文件进行读写操作，逻辑上没毛病。以下代码通过Dir函数判断文件或者文件夹是否存在： 1）Dir(文件地址)<>””，若结果为True，表示文件存在 2）Dir(文件地址夹地址, vbDirectory)<>””，若结果为True，表示文件夹存在，Directory就是目录，文件夹的意思，前面一个vb，为VBA保留关键字 Sub test3() currentPath = ThisWorkbook.Path folderAddress = currentPath & "\" & "图片库" photoName = "张三.png" photoAddress = folderAddress & "\" & photoName folderAddress2 = currentPath & "\" & "图片库2" photoName = "张三2.png" photoAddress2 = folderAddress & "\" & photoName If Dir(folderAddress, vbDirectory) <> "" Then Debug.Print ("1：文件夹存在") End If If Dir(photoAddress) <> "" Then Debug.Print ("1：文件存在") End If If Dir(folderAddress2, vbDirectory) <> "" Then Debug.Print ("2：文件夹存在") Else Debug.Print ("2：文件夹不存在") End If If Dir(photoAddress2) <> "" Then Debug.Print ("2：文件存在") Else Debug.Print ("2：文件不存在") End If End Sub 执行结果： 1：文件夹存在 1：文件存在 2：文件夹不存在 2：文件不存在 4.4.4-文件操作：复制、删除、重命名 文件的常见操作有复制、删除、重命名，以上操作对所有类型的文件都是通用的。 1）文件复制：FileCopy 原文件绝对地址,复制后文件的绝对地址，新生成了一个一模一样的文件 2）文件重命名：Name 原文件绝对地址 As 重命名后的文件绝对地址，没有产生新文件，只是修改了文件名，如果前后文件所处文件夹地址变了，表示移动了文件，也就是说该功能同样可以实现移动文件功能。 3）文件删除：Kill 文件绝对地址 以上三步操作都需要先确认该文件是否存在，对不存在的文件进行赋值、删除、重命名会报错。 Sub test4() currentPath = ThisWorkbook.Path folderAddress = currentPath & "\" & "删除" fileXName = "1.txt" fileXAddress = folderAddress & "\" & fileXName newFileXAddress = folderAddress & "\2.txt" new2FileXAddress = folderAddress & "\3.txt" FileCopy fileXAddress, newFileXAddress Name newFileXAddress As new2FileXAddress Kill fileXAddress End Sub 4.4.5-跳出循环或函数或过程 当我们使用循环寻找信息时，当找到需要的信息时，希望循环立刻终止，减少不必要的资源浪费。我们这时候就可以使用Exit For，表示立即终止当前循环，继续执行For…Next后的代码。 以下代码输出的结果如图4-11所示，当i取值为5时，If i = 5 Then为True，执行Exit For，退出循环，执行循环体后的语句Debug.Print ("程序执行完毕")。 Sub test5() For i = 1 To 1000 Step 1 If i = 5 Then Exit For Else Debug.Print (i) End If Next i Debug.Print ("程序执行完毕") End Sub
当有多层循环时，从Exit For向上数，遇到的第一个For 循环为其退出的循环。以下代码执行的结果如图4-12所示 Sub test6() For i = 1 To 2 Step 1 For j = 1 To 100 Step 1 If j = 5 Then Exit For Else Debug.Print (j) End If Next j Next i Debug.Print ("程序执行完毕") End Sub
Exit也可以退出Sub，以下代码退出当前Sub过程，执行结果如图4-13，从结果发现Exit Sub后的代码全部没有被执行。 Sub test7()
Debug.Print ("程序执行开始")
x = 1
If x = 1 Then
Exit Sub
End If
Debug.Print ("程序执行完毕")End Sub
同理Exit也可以退出Function，以下代码执行结果如图4-14所示，fun8函数只返回了2。如果分步调试执行代码，你会发现，当运行到Exit Function，整个fun8函数就执行完毕了。 Sub test8() x = fun8() Debug.Print (x)End SubFunction fun8() fun8 = 2 Exit Function fun8 = 3End Function
综上所述，Exit的效果就是退出，合理使用Exit，极大节约计算机资源 4.5-本章示例代码详解 4.5.1-代码结构解析 4.5.2-代码解析：L1_Sub_生成个人档案 4.5.3-代码解析：L11_Fun_createPersonalFile 4.5.4-代码解析：L111_Fun_人员信息 4.5.5-代码解析：L112_Fun_考核成绩 4.5.6-代码解析：L113_Sub_证书 4.5.7-代码解析：L115_Sub_员工照片 4.5.1-代码结构解析 代码整体结构如图4-15所示，在界面端只需要点击一次按钮，以下8个过程或者函数会依次运行。因为只需要一次触发就可以执行程序，理论上来说可以将所有代码写在一个Sub或者Function中，那么为什么不这么做呢？这个就像写作文一样，也不会只写一段，主要有几点考虑： 1）代码的复用，同一局部功能，使用一个函数或者过程实现，这样下次再需要使用时，直接调用即可，无需重复去写 2）方便后续调试，每个Sub或者Function都有自己的功能，当出现bug问题时，可以快速定位问题所在Sub或者Function，不用通读全篇代码 3）逻辑更清晰，一个比较复杂的项目可能需要很多天才能完成，把代码分成不同的Sub或者Function，就像分别完成不同的模块，最后组装即可 简而言之，这种方式成本更低，更高效，对写代码的人和看看代码的人都比较友好
|
|
|
来自： asaser > 《 Excel-VBA简明教程》
