系统:Windows 10
软件:Excel 2016
- 本系列是假设一种应用场景,键盘质量检查中,发现问题,如何在键盘图片上进行标记和后续的跟踪管理
- 其实也同样适用在其它应用场景,尤其与位置相关的质量特性管理上
- 核心知识点:在背景图片特定位置插入一个圆圈(表示问题点),并对圆圈进行进行颜色等特性的改变
Part 1: 项目功能介绍(更新)
- 在写的过程中,发现需要修正一下上次的功能,功能模块如下
- 录入问题(OK)
- 录入尺寸问题,标记圆形
- 录入颜色问题,标记矩形
- 清空显示问题
- 保存当前状态:新增的问题点位置和颜色都是动态变化的,需要保存最新状态
- 删除问题(OK)
- 基于问题唯一ID号删除某问题
- 查询问题,基于以下条件条件逻辑与进行查询,若无选择条件,默认显示所有问题(OK)
- 基于问题状态:已解决,未解决
- 问题种类:尺寸,颜色
- 问题ID号,只显示特定ID号问题
- 时间节点:超期,未超期
- 选中图片上问题获取其对应的问题信息
- 问题修改(OK)
- 修改问题状态,更新其颜色表示,未解决-红色;已解决-绿色
- 考虑到操作的便利性,对于录入问题部分,设置快捷键(OK)
操作界面(仅做示意,并不表示真有质量问题;如有侵权请联系我)
Part 2: 拟实现功能描述
- 本次拟实现识别未解决问题中超期问题的显示和数目统计
过程动图
静图
Part 3: 代码逻辑
- 清除原有图形
- 新增两个变量,用来存储未解决问题中的尺寸问题、颜色问题数目,并初始化为0
- 获取当前日期
- 对数据库区域进行循环,多层判断
- 判断问题是否已解决
- 对未解决的问题,判断有无时间节点,这里没有时间节点暂不考虑
- 有时间节点的,与当前日期比对,小于当前日期的,为超期问题
- 画图
Part 4:代码
超期问题获取
Sub exceedTime()
Call delAllShape
sizeProblem = 0
colorProblem = 0
currentDate = Date
Set sht = ThisWorkbook.Worksheets("问题管理")
' 获取行数
maxRow = sht.Cells(Rows.Count, "Q").End(xlUp).Row
For i = 3 To maxRow Step 1
problemStatus = sht.Cells(i, "L").Value
If problemStatus = "未解决" Then
solveDate = sht.Cells(i, "P").Value
If solveDate <> "" Then
solveDate = CDate(solveDate)
If solveDate < currentDate Then
shapeName = sht.Cells(i, "Q").Value
problemType = sht.Cells(i, "K").Value
If problemType = "尺寸" Then
shapeType = msoShapeOval
sizeProblem = sizeProblem + 1
Else
shapeType = msoShapeRectangle
colorProblem = colorProblem + 1
End If
positionX = sht.Cells(i, "R").Value
positionY = sht.Cells(i, "S").Value
widthVal = sht.Cells(i, "T").Value
heightVal = sht.Cells(i, "U").Value
fillColor = sht.Cells(i, "V").Value
lineColor = sht.Cells(i, "W").Value
shapeName = drawShape(sht, shapeType, positionX, positionY, widthVal, heightVal, fillColor, lineColor)
sht.Cells(i, "Q").Value = shapeName
End If
End If
End If
Next i
sht.Range("H18") = sizeProblem
sht.Range("H19") = colorProblem
End Sub
画图
Function drawShape(sht, shapeType, positionX, positionY, widthVal, heightVal, fillColor, lineColor)
Set newShape = sht.Shapes.AddShape(shapeType, positionX, positionY, widthVal, heightVal)
shapeName = newShape.Name
Debug.Print (shapeName)
With newShape.Fill
.Visible = msoTrue
.ForeColor.RGB = fillColor
.Transparency = 0
.Solid
End With
With newShape.Line
.Visible = msoTrue
.ForeColor.RGB = lineColor
.Transparency = 0
End With
drawShape = shapeName
End Function
代码截图
超期问题获取
画图
Part 5:部分代码解读
currentDate = Date
获取当前日期,为时间格式solveDate = CDate(solveDate)
将字符串格式转换为日期格式,可能存在风险,如果两边日期的写法不同,如日和月的位置不同,在对比大小时,不知道是否可以识别出来。读者可以试一试
- 更多学习交流,可加小编微信号
learningBin
更多精彩,请关注微信公众号
扫描二维码,关注本公众号