Excel-VBA-质量问题可视化管理-15-多个圆表征一个问题

系统：Windows 10
软件：Excel 2016

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

Part 1： 项目功能介绍

1. 上一个部分的功能已经实现，重复的部分不再赘述
2. 接下来的几篇文章说一个延伸功能。之前的文章中，1个问题只有一个形状来表征，或者圆形或者矩形。当一个问题需要几个形状的时候，如何实现。这一部分涉及功能如下
   • 多形状定义一个问题，采用直线来做，基于之前的文章已说明，无法获取到直线的位置数据，所以改用多个圆来表征
   • 删除问题
   • 查询问题

Part 2： 拟实现功能描述

1. 本次拟实现功能：新增一个问题后，采用多个圆圈来表征
2. 为了区别这些圆圈，在圆圈内部写上了数字

效果如下

动图

Part 2：代码

Sub 新增问题2()
    Set sht = ThisWorkbook.Worksheets("问题管理")
    problemID = sht.Range("B16")
    
    flag = 0
    If problemID = "" Then
        flag = 1
        problemID = "P-" & getUniqueId()
        
        ' 把新增的问题ID写入
        sht.Range("B16") = problemID
    End If
    
    ' 获取行数
    maxRow = sht.Cells(Rows.Count, "O").End(xlUp).Row
    inputRow = maxRow + 1
    middleTxt = CStr(inputRow - 2)
    
    widthVal = 20
    heightVal = 20
    positionX = sht.Range("B22").Left
    positionY = sht.Range("B22").Top
    
    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
    
    shapeName = newShape.Name
    
    With newShape.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With

    With newShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    
    shapeID = "S-" & getUniqueId()


    
    ' 获取颜色十进制表示
    fillColorRGB = newShape.Fill.ForeColor.RGB
    lineColorRGB = newShape.Line.ForeColor.RGB
    
    ' 写入表格
    sht.Cells(inputRow, "N").Value = problemID
    sht.Cells(inputRow, "O").Value = shapeID
    sht.Cells(inputRow, "P").Value = shapeName
    sht.Cells(inputRow, "Q").Value = positionX
    sht.Cells(inputRow, "R").Value = positionY
    sht.Cells(inputRow, "S").Value = widthVal
    sht.Cells(inputRow, "T").Value = heightVal
    sht.Cells(inputRow, "U").Value = fillColorRGB
    sht.Cells(inputRow, "V").Value = lineColorRGB
    sht.Cells(inputRow, "W").Value = middleTxt

End Sub

代码截图

执行结果

Part 3：部分代码解读

1. middleTxt = CStr(inputRow - 2)获取行号，将其设置为圆圈内的文字
2. newShape.TextFrame2.TextRange.Characters.Text = middleTxt，将上面的字符设置为圆圈内的文字，也是通过录制宏才获取到这一段代码
3. 将圆圈内部的文字居中
   • newShape.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
   • newShape.TextFrame2.VerticalAnchor = msoAnchorMiddle

---

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

---

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