Excel-VBA-质量问题可视化管理-18-查询问题

系统：Windows 10
软件：Excel 2016

• 本系列是假设一种应用场景，键盘质量检查中，发现问题，如何在键盘图片上进行标记和后续的跟踪管理。其实也同样适用在其它应用场景，尤其与位置相关的质量特性管理上

Part 1： 项目功能介绍

1. 之前介绍了基于单形状问题表征的一系列操作
2. 接下来讲讲基于多形状的问题表征，只介绍以下核心4大功能
   • 增，定义问题，采用多圆形来表征
   • 删，删除一个问题
   • 改，基于问题号修改问题
   • 查，基于问题号查询问题，今天介绍一下

Part 2： 查询

1. 给出问题ID号，查询对应的形状，其实要求在查询之前清除其它无关形状，这里没有写了，可以查询之前的文章，过程如图1所示

图1 动图

Part 3： 代码

Sub 查询问题()
    Set sht = ThisWorkbook.Worksheets("问题管理")
    problemID = sht.Range("B15")
    
    ' 问题
    maxRow = sht.Cells(Rows.Count, "N").End(xlUp).Row
    
    For i = 3 To maxRow Step 1
        existsID = sht.Cells(i, "N")
        If existsID = problemID Then
                positionX = sht.Cells(i, "Q")
                positionY = sht.Cells(i, "R")
                widthVal = sht.Cells(i, "S")
                heightVal = sht.Cells(i, "T")
                fillColorRGB = sht.Cells(i, "U")
                lineColorRGB = sht.Cells(i, "V")
                middleTxt = sht.Cells(i, "W")
                
                Set newShape = sht.Shapes.AddShape(msoShapeOval, positionX, positionY, widthVal, heightVal)
                newShape.TextFrame2.TextRange.Characters.Text = middleTxt
                
                ' 文字居中
                newShape.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
                newShape.TextFrame2.VerticalAnchor = msoAnchorMiddle
                newShape.TextFrame2.TextRange.Font.Size = 6
                
                With newShape.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = fillColorRGB
                    .Transparency = 0
                    .Solid
                End With
                
                With newShape.Line
                    .Visible = msoTrue
                    .ForeColor.RGB = lineColorRGB
                    .Transparency = 0
                End With
                
        End If
    Next

    
End Sub

代码截图

Part 4：部分代码解读

1. 查询部分本质上还是新增形状，所以代码部分也是一样的

---

• 更多学习交流，可加小编微信号learningBin

---

更多精彩，请关注微信公众号
扫描二维码，关注本公众号