VBA实例1 Excel人员资质及证件管理
目录
- VBA实例之Excel台账 人员资质及证件管理
- 问题引入
- 思路
- 快捷键设置
- 效果
- Excel截屏
- 视频演示
- 具体实现
- 单个图片
- 对所有图像进行排版
- 对头像进一步处理
- 关键词检索
VBA实例之Excel台账 人员资质及证件管理
问题引入
大多数中小型企业并不会花费额外的价钱购买文件管理系统，打工人每天重复录入信息、制表、绘图、排版等等，无疑是个异常枯燥乏味且没有意义的过程。VBA虽然已经过时了，但依旧是提高办公效率的一个不错的选择。这里为什么不用Python，明明Python具有更高效更便捷的优势？主要原因是Excel内置py的插件都是付费的，而且订阅费用不低。让公司掏这个钱显然是不现实的，我于是从去年开始重拾VBA，
思路
- one_image_aspect：当复制粘贴一张图像到Excel单元格中时，进行初步的格式处理。
- image_aspect：根据给定的宽高值（分别对应单元格L2与N2中的值）对头像列与证件列行高、列宽进行调整，同时遍历当前激活的表中所有图像，调整图像宽高值。图像名赋值到所在单元格。
- avatar：a.当头像列没有头像时，检查身份证正面列有无头像，若有，通过复制与裁剪生成头像；b.进一步调整头像格式。
- TextBox1_Change：a.筛选姓名；b.筛选姓名和单位名称 输入文本时姓名与单位名称中间加空格。
快捷键设置
不会用快捷键的打工人不是合格的打工人。
快捷键的设置仅为个人习惯，在人员信息管理台账、隐患排查治理台账、标识标签管理台账与事故管理台账等文件体系中，我习惯用以下三组快捷键作为默认快捷键。
one_image_aspect：Ctrl + M
image_aspect：Ctrl + Shift + M
avatar：Ctrl + Shift + X
效果
Excel截屏
为便于展示，在网上找了几组证件的图像（侵删）。
视频演示
视频审核中，待插入……
具体实现
代码很简单，语法和算法不做赘述。需要注意的是，在Excel中，图像并非单元格中的值，不能通过访问单元格中值来获取图像的相关参数。较为常用的一种做法是，遍历图像，通过图像左上角（其他角亦然）所在单元格地址来判断从属关系。VBA因为未知问题，在图像处理过程中容易报错，建议对图像进行压缩处理，压缩为220ppi，以减少故障率。
单个图片
Sub one_image_aspect()Dim image_width As Single, image_height As SingleDim name As String, idx As Integer, shp As ShapeRange, tlc_address As Stringimage_width = Cells(2, "L")image_height = Cells(2, "N")Application.ScreenUpdating = FalseRows(Selection.Cells(1, 1).Row).RowHeight = Application.CentimetersToPoints(image_height) + 4ActiveSheet.PasteSet shp = Selection.ShapeRangeshp.Left = Selection.Left + 2shp.Top = Selection.Top + 2shp.LockAspectRatio = msoFalseshp.Width = Application.CentimetersToPoints(image_width)shp.Height = Application.CentimetersToPoints(image_height)Application.ScreenUpdating = True
End Sub
对所有图像进行排版
Sub image_aspect()Dim image_width As Single, image_height As SingleDim name As String, idx As Integer, shp As Shape, tlc_address As StringApplication.ScreenUpdating = FalseRange(Cells(1, "A"), Cells(1, "H")).Borders(xlEdgeLeft).Weight = xlThinRange(Cells(1, "A"), Cells(1, "H")).Borders(xlEdgeTop).Weight = xlThinRange(Cells(1, "A"), Cells(1, "H")).Borders(xlEdgeRight).Weight = xlThinRange(Cells(1, "A"), Cells(1, "H")).Borders(xlEdgeBottom).Weight = xlThinRange(Cells(1, "A"), Cells(1, "H")).Borders(xlInsideHorizontal).Weight = xlThinRange(Cells(1, "A"), Cells(1, "H")).Borders(xlInsideVertical).Weight = xlThinimage_width = Cells(2, "L")image_height = Cells(2, "N")For idx = 97 + 4 To 100 + 4Range(Chr(idx) & ":" & Chr(idx)).ColumnWidth = (Application.CentimetersToPoints(image_width) + 4) / 6.1Next idxidx = 2name = Cells(idx, 2)While Len(name)Range(Cells(idx, "A"), Cells(idx, "H")).Borders(xlEdgeLeft).Weight = xlThinRange(Cells(idx, "A"), Cells(idx, "H")).Borders(xlEdgeTop).Weight = xlThinRange(Cells(idx, "A"), Cells(idx, "H")).Borders(xlEdgeRight).Weight = xlThinRange(Cells(idx, "A"), Cells(idx, "H")).Borders(xlEdgeBottom).Weight = xlThinRange(Cells(idx, "A"), Cells(idx, "H")).Borders(xlInsideHorizontal).Weight = xlThinRange(Cells(idx, "A"), Cells(idx, "H")).Borders(xlInsideVertical).Weight = xlThinRange(idx & ":" & idx).RowHeight = Application.CentimetersToPoints(image_height) + 4idx = idx + 1name = Cells(idx, 2)WendRange("D2:H" & idx - 1) = NullFor Each shp In ActiveSheet.ShapesIf shp.Type = msoPicture Thenshp.Placement = xlMoveAndSizeshp.LockAspectRatio = msoFalsetlc_address = shp.TopLeftCell.AddressIf Range(tlc_address).Column > 4 ThenRange(tlc_address) = shp.nameshp.Left = Range(tlc_address).Left + 2shp.Top = Range(tlc_address).Top + 2shp.LockAspectRatio = msoFalseshp.Width = Application.CentimetersToPoints(image_width)shp.Height = Application.CentimetersToPoints(image_height)ElseIf Range(tlc_address).Column = 4 ThenRange(tlc_address) = shp.nameshp.Left = Range(tlc_address).Left + 2shp.Top = Range(tlc_address).Top + 2shp.Width = Range(tlc_address).Width - 4shp.Height = Range(tlc_address).Height - 4End IfEnd IfNext
End Sub
对头像进一步处理
Sub avatar()Call image_aspectDim L As Single, R As Single, T As Single, B As SingleDim original_width As Single, original_height As SingleDim shp As ShapeRange, idx As Integer, pic_name As StringDim face_picture As Shape, name As String, tlc_address As StringL = 0.65R = 0.09T = 0.15B = 0.28idx = 2name = Cells(idx, 2)pic_name = Cells(idx, 5)While Len(name) > 0If Len(Cells(idx, 4)) = 0 And Len(pic_name) > 0 ThenSet temp = Cells(idx, 4)Shapes(Cells(idx, 5)).CopyCells(idx, 4).ActivateActiveSheet.PasteSet shp = Selection.ShapeRangeSelection.Placement = xlMoveAndSizeshp.LockAspectRatio = msoFalseshp.ScaleWidth 1, msoCTrueshp.ScaleHeight 1, msoCTrueshp.LockAspectRatio = msoTrueoriginal_width = shp.Widthoriginal_height = shp.Heightshp.PictureFormat.CropLeft = original_width * Lshp.PictureFormat.CropRight = original_width * Rshp.PictureFormat.CropTop = original_height * Tshp.PictureFormat.CropBottom = original_height * Bshp.Left = Cells(idx, 4).Left + 2shp.Top = Cells(idx, 4).Top + 2shp.LockAspectRatio = msoFalseshp.Width = Cells(idx, 4).Width - 4shp.Height = Cells(idx, 4).Height - 4Range("D" & idx) = shp.nameEnd Ifidx = idx + 1pic_name = Cells(idx, 5)name = Cells(idx, 2)Wend
End Sub关键词检索
Private Sub TextBox1_Change()Dim max_row As Integer, name As String, company As Stringmax_row = 1While Len(Cells(max_row + 1, 1)) > 0max_row = max_row + 1WendIf InStr(TextBox1, " ") Thenname = Split(TextBox1, " ")(0)company = Split(TextBox1, " ")(1)Range("A2:H" & max_row).AutoFilter field:=3, Criteria1:="*" & company & "*"Elsename = TextBox1.TextEnd IfRange("A2:H" & max_row).AutoFilter field:=2, Criteria1:="*" & name & "*"
End Sub
VBA实例1 Excel人员资质及证件管理相关推荐
- excel制作录入和查询系统_叮咚！您有一份Excel人员信息查询系统，请您查收~
叮咚!您有一份Excel人员信息查询系统,请您查收~ 打开中-- 1 2 3 open! 哦豁,瞅着还不错哦~ 下面介绍如何制作一个简易的人员信息查询系统. 数据源准备 第一步当然是准备数据源,数据源 ...
- 视频教程-EXCEL VBA编程（excel办公高手必经之路）-Office/WPS
EXCEL VBA编程(excel办公高手必经之路) Office培训讲师,51CTO金牌讲师,从2005开始从事Office培训至今.擅长Excel.Word.PowerPoint等软件的应用,著有 ...
- vba和python哪个好学-Python或将取代VBA，成为Excel官方脚本语言？？？
原标题:Python或将取代VBA,成为Excel官方脚本语言??? 微软正考虑添加 Python 为官方的 Excel 脚本语言 据外媒报道,微软正考虑添加 Python 为官方的一种 Excel ...
- abaqus python实例_abaqus Python实例-操作excel文件
abaqus Python实例--操作excel文件目前处理数据离不开excel,所以pythoner必须学会用python操作excel表格.Python 与excel交互方法也比较多,我一开始就接 ...
- vb python excel_【Python3+VBA】在Excel中生成小姐姐
原标题:[Python3+VBA]在Excel中生成小姐姐 开发工具 Python版本:3.6.4 相关模块:PIL模块:openpyxl模块:以及一些Python自带的模块. Excel版本:Exc ...
- vba html 转化为 xlsx,使用VBA批量转换Excel格式，由.xls转换成.xlsx
问题分析: Excel2007以前的格式是.xls,之后的格式是.xlsx.打开单独的一个Excel文档,使用"另存为"功能,可以很轻松的转换格式.但是面对几百个Excel表这样就 ...
- [Win10+Excel365]尽管已启用VBA宏，Excel还是无法运行宏
问题 尽管已"启用VBA宏",Excel(Microsoft 365)还是无法运行宏."可能是因为该宏在此工作簿中不可用,或者所有的宏都被禁用". 环境 Win ...
- python vba excel课程_【Python3+VBA】在Excel中生成小姐姐|python3教程|python入门|python教程...
https://www.xin3721.com/eschool/pythonxin3721/ 本文转载至知乎ID:Charles(白露未晞)知乎个人专栏 下载W3Cschool手机App,0基础随时随 ...
- VBA 实例：Word 转 TXT
VBA 实例:Word 转 TXT Word 直接另存为 txt 处理错误文件 处理:6296 处理:5792 Word 直接另存为 txt Option ExplicitPublic Const I ...
最新文章
- 【Dual-Path-RNN-Pytorch源码分析】AudioReader
- 抽象工厂模式(Absraact Factory)介绍与实现
- mysql varchar 长度限制_MySQL数据库varchar的限制规则说明
- netty消息分发思路
- 给你出道题：依次去掉离中心最远的M个点
- linux下tar gz bz2 tgz z等众多压缩文件的解压方法
- php视图最佳实践,PHP 的最佳实践
- VS 提示：请考虑使用 app.config 将程序集“XXX”从版本“XX”重新映射到版本“XX”，以解决冲突并消除警告。...
- 鼠标回报率测试软件用哪个,揭开鼠标的秘密 艾尚教你如何测回报率
- 基于高德地图的交通数据分析
- 在腾讯实习一年，我学到了什么
- 【东方博宜】【入门】1326--需要安排几位师傅加工零件？
- 域名解析-/etc/hosts
- 工业级环网交换机是做什么的？
- 【EMC基础篇①】噪声是什么
- PHP汉字转拼音函数
- android系统ime指令
- SAR图像相干斑滤波算法
- Python全栈（十）Django框架之9.聚合函数和表达式
- [附源码]java毕业设计超市订单管理系统