6.3.2-新增形状

对于尺寸问题或者颜色问题，区别不大，只是形状不同而已，所以核心代码几乎一致。主要功能是生成对应的形状，并将该形状的基础信息写入数据库，包括位置、大小、颜色等信息

代码如下

Sub 新增尺寸问题()
    Set sht = ThisWorkbook.Worksheets("问题管理")
    positionX = sht.Range("B22").Left
    positionY = sht.Range("B22").Top
    
    widthVal = 12
    heightVal = 12
    Set newShape = sht.Shapes.AddShape(msoShapeOval, positionX, positionY, widthVal, heightVal)
    shapeName = newShape.Name
    Debug.Print (shapeName)
    
    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
    
    ' 获取行数
    maxRow = sht.Cells(Rows.Count, "Q").End(xlUp).Row
    inputRow = maxRow + 1
    
    ' 获取颜色十进制表示
    fillColorRGB = newShape.Fill.ForeColor.RGB
    lineColorRGB = newShape.Line.ForeColor.RGB
    
    ' 写入表格
    sht.Cells(inputRow, "Q").Value = shapeName
    sht.Cells(inputRow, "R").Value = positionX
    sht.Cells(inputRow, "S").Value = positionY
    sht.Cells(inputRow, "T").Value = widthVal
    sht.Cells(inputRow, "U").Value = heightVal
    sht.Cells(inputRow, "V").Value = fillColorRGB
    sht.Cells(inputRow, "W").Value = lineColorRGB
    
    sht.Cells(inputRow, "J").Value = getUniqueId()
    sht.Cells(inputRow, "K").Value = "尺寸"
    sht.Cells(inputRow, "L").Value = "未解决"

    ' 清空之前的标记，增加新标记
    sht.Range("X:X").ClearContents
    sht.Range("X2") = "标记"
    sht.Cells(inputRow, "X") = "新增点"
    
End Sub
Sub 新增颜色问题()
    Set sht = ThisWorkbook.Worksheets("问题管理")
    positionX = sht.Range("F22").Left
    positionY = sht.Range("F22").Top
    
    widthVal = 20
    heightVal = 12
    Set newShape = sht.Shapes.AddShape(msoShapeRectangle, positionX, positionY, widthVal, heightVal)
    shapeName = newShape.Name
    Debug.Print (shapeName)
    
    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
    
    ' 获取行数
    maxRow = sht.Cells(Rows.Count, "Q").End(xlUp).Row
    inputRow = maxRow + 1
    
    ' 获取颜色十进制表示
    fillColorRGB = newShape.Fill.ForeColor.RGB
    lineColorRGB = newShape.Line.ForeColor.RGB
    
    ' 写入表格
    sht.Cells(inputRow, "Q").Value = shapeName
    sht.Cells(inputRow, "R").Value = positionX
    sht.Cells(inputRow, "S").Value = positionY
    sht.Cells(inputRow, "T").Value = widthVal
    sht.Cells(inputRow, "U").Value = heightVal
    sht.Cells(inputRow, "V").Value = fillColorRGB
    sht.Cells(inputRow, "W").Value = lineColorRGB

    sht.Cells(inputRow, "J").Value = getUniqueId()
    sht.Cells(inputRow, "K").Value = "颜色"
    sht.Cells(inputRow, "L").Value = "未解决"

    
    ' 清空之前的标记，增加新标记
    sht.Range("X:X").ClearContents
    sht.Range("X2") = "标记"
    sht.Cells(inputRow, "X") = "新增点"
    
End Sub

其中新增一个形状为以上的代码的关键核心代码，具体如下：

Set newShape = sht.Shapes.AddShape(msoShapeOval, positionX, positionY, widthVal, heightVal)

• 1）其中msoShapeOval为形状信息，表示圆形，如果为矩形，则为msoShapeRectangle，从单词意思上应该也可以快速理解。这两个都为VBA中自带的常量

• 1.1）Oval：椭圆形

• 1.2）Rectangle：矩形

• 2）positionX, positionY，为形状左上角的位置，一般通过单元格位置获取，以下表示为单元格B22的左上角位置

• 2.1）positionX = sht.Range(“B22”).Left

• 2.2）positionY = sht.Range(“B22”).Top

• 3）widthVal, heightVal，为形状信息，分别表示宽度和高度，以下表示为宽度和高度都为12，所以此时的椭圆形成了圆形，这个单位是多少暂未知，可以通过尝试数值，看一下所需要的具体数值

• 3.1）widthVal = 12

• 3.2）heightVal = 12