Excel-VBA-质量问题可视化管理-06-显示所有问题

最新推荐文章于 2021-12-27 20:28:20 发布

Coding的巴扎黑

最新推荐文章于 2021-12-27 20:28:20 发布

阅读量287

点赞数

分类专栏： VBA-Excel

本文链接：https://blog.csdn.net/zishendianxia/article/details/113726668

版权

VBA-Excel 专栏收录该内容

39 篇文章 7 订阅

订阅专栏

系统：Windows 7
软件：Excel 2016

本系列是假设一种应用场景，键盘质量检查中，发现问题，如何在键盘图片上进行标记和后续的跟踪管理
其实也同样适用在其它应用场景，尤其与位置相关的质量特性管理上
核心知识点：在背景图片特定位置插入一个圆圈（表示问题点），并对圆圈进行进行颜色等特性的改变

Part 1：项目功能介绍（更新）

在写的过程中，发现需要修正一下上次的功能，功能模块如下
录入问题
- 录入尺寸问题，标记圆形
- 录入颜色问题，标记矩形
- 清空显示问题
- 保存当前状态：新增的问题点位置和颜色都是动态变化的，需要保存最新状态
删除问题
- 基于问题唯一ID号删除某问题
查询问题，基于以下三个条件逻辑与进行查询，若无选择条件，默认显示所有问题
- 基于问题状态：已解决，未解决
- 问题种类：尺寸，颜色
- 时间节点：超期，未超期
考虑到操作的便利性，对于录入问题部分，设置快捷键

操作界面（仅做示意，并不表示真有质量问题；如有侵权请联系我）
在这里插入图片描述

Part 2：拟实现功能描述

本次拟实现显示所有数据库中显示的问题
基本逻辑如下：
- 删除当前界面中所存在的shape（保留按钮和底图，防止误删）
- 重新绘制数据库中所有的问题

效果动图
在这里插入图片描述

Part 3：代码

Function reserveShape(shapeName, shapeArray)
    result = False
    
    For Each ele In shapeArray
        If shapeName = ele Then
            result = True
            Exit For
        End If
    Next
    
    reserveShape = result

End Function
Sub delAllShape()
    Set sht = ThisWorkbook.Worksheets("问题管理")
    
    shapeArray = Array("Picture 20", "Button 12", "Button 13", _
    "Button 14", "Button 15", "Button 16", "Button 17")
    
    For Each sh In sht.Shapes
        shapeName = sh.Name
        
        reserveYn = reserveShape(shapeName, shapeArray)
        If Not reserveYn Then
            sh.Delete
        End If
    Next
    
End Sub
Sub showAllProblem()
    Call delAllShape
    Set sht = ThisWorkbook.Worksheets("问题管理")
    ' 获取行数
    maxRow = sht.Cells(Rows.Count, "Q").End(xlUp).Row
    
    For i = 3 To maxRow Step 1
        shapeName = sht.Cells(i, "Q").Value
        questionType = sht.Cells(i, "K").Value
        
        If questionType = "尺寸" Then
            shapeType = msoShapeOval
        Else
            shapeType = msoShapeRectangle
        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
        
        Set newShape = sht.Shapes.AddShape(shapeType, positionX, positionY, widthVal, heightVal)
        shapeName = newShape.Name
        Debug.Print (shapeName)
        
        sht.Cells(i, "Q").Value = 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
                   
    Next i
End Sub

代码截图

在这里插入图片描述

Part 4：部分代码说明

删除已经存在的shape对象，按钮和背景图片也是属于shape对象，所以需要将这些排除在外，那么如何获取这些对象的名称呢？录制宏，选择这些图片，进行放大缩小类操作，再查看录制宏代码，即可获取对象名称

获取图片或按钮的内部名称
在这里插入图片描述

新增shape对象Set newShape = sht.Shapes.AddShape(shapeType, positionX, positionY, widthVal, heightVal)，新增的shape对象与之前标记的虽然位置/大小/颜色都一致，但内部变量名称不一致，所以修改了数据库中区域的名称sht.Cells(i, "Q").Value = shapeName