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-本章小结
引言
本章依然采用一个小项目的方式,介绍新的知识点。本章介绍的知识点如下:
Excel插入图片
工作表的生成
图表设置
某公司的员工信息记录在一个Excel文件中,分成多个表来记录:人员信息、考核成绩、证书信息、获奖信息四个工作表,如图4-1所示。现有一个需求就是获取每一个人的个人档案,涵盖以上信息加上个人照片,个人档案的Excel模板如图4-2所示。
4.2-项目架构
4.2.1-系统可见部分
4.2.2-项目代码逻辑
将原档案文件另存为个人档案批量生成.xlsm,增加操作界面工作表,整体布局如图4-3所示。
1)第1步是用来清空上一次填写的员工姓名及提示信息,本章不单独介绍。
2)第2步是基于B列输入的员工姓名进行员工档案文件的自动生成
该项目所处文件夹做了简单的规范化管理,如图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列
初学者,建议将以下代码打印出来,拿出笔一行一行去看,当然后文我也是一行一行解读的
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,就像分别完成不同的模块,最后组装即可
简而言之,这种方式成本更低,更高效,对写代码的人和看看代码的人都比较友好
联系客服