Excel-VBA-质量问题可视化管理-02-小圆圈颜色修改

系统：Windows 7
软件：Excel 2016

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

Part 1： 项目基本介绍

1. 假设键盘的检查质量特性有：尺寸，颜色2种质量特性
2. 每次对生产的键盘进行质量特性检查时，将具体问题在键盘图片上进行位置标记
   • 尺寸质量问题，使用圆形标记
   • 颜色质量问题，使用矩形进行标记
   • 红色表示不达标；绿色表示已达标
3. 效果类似下图，随着文章的撰写，可能也会添加一些新的需求，欢迎读者提供有意思的想法

键盘图片（仅做示意，并不表示真有质量问题；如有侵权请联系我）

Part 2： 万里长征第2步：修改小圆圈颜色

1. 对于上一篇的文章生成的小圆圈，可以理解为质量问题的区域
2. 那么实际质量问题可以简单分为三个状态
   • 红色，问题发现，无措施
   • 黄色，有措施，执行中
   • 绿色，问题已解决
3. 本文的目的就是修改小圆圈的颜色

颜色修改

Part 3：代码

Sub changeColor()
    Set sht = ThisWorkbook.Worksheets("测试")
    shapeColor = sht.Range("D2")
    
    If shapeColor = "红色" Then
        fillColorR = 255
        fillColorG = 0
        fillColorB = 0
        
        lineColorR = 255
        lineColorG = 0
        lineColorB = 0
    ElseIf shapeColor = "黄色" Then
        fillColorR = 255
        fillColorG = 192
        fillColorB = 0
        
        lineColorR = 255
        lineColorG = 192
        lineColorB = 0
    ElseIf shapeColor = "绿色" Then
        fillColorR = 0
        fillColorG = 176
        fillColorB = 80
        
        lineColorR = 0
        lineColorG = 176
        lineColorB = 80
    Else
        MsgBox "该颜色未识别"
    End If
    
    sht.Cells(2, "K").Value = fillColorR
    sht.Cells(2, "L").Value = fillColorG
    sht.Cells(2, "M").Value = fillColorB
    sht.Cells(2, "N").Value = lineColorR
    sht.Cells(2, "O").Value = lineColorG
    sht.Cells(2, "P").Value = lineColorB
    
    shapeName = sht.Cells(2, "F").Value
    Set newShape = sht.Shapes.Range(Array(shapeName))
    
    With newShape.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(fillColorR, fillColorG, fillColorB)
        .Transparency = 0
        .Solid
    End With
    
    With newShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(lineColorR, lineColorG, lineColorB)
        .Transparency = 0
    End With
    
End Sub

代码截图

结果

Part 4： 部分代码说明

1. 颜色RGB值获取
   • 可以通过录制宏实现，将颜色与RGB值一一对应
2. 小圆圈对象获取
   • Set newShape = sht.Shapes.Range(Array(shapeName))，获取小圆圈对象，这里的写法是可以同时获取多个对象的。
   • 对于只获取一个对象，也可以这么写Set newShape = sht.Shapes(shapeName)
3. 修改小圆圈颜色
   • 通过newShape.Fill修改填充颜色
   • 通过newShape.Line修改轮廓颜色

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

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

标签：02,newShape,VBA,sht,Cells,Excel,Value,颜色,小圆圈
来源： https://blog.csdn.net/zishendianxia/article/details/110258359