6.3.3-保存形状

默认生成的形状是在固定位置，这跟我们最终想要的位置肯定是不符的，所以此时加入了手工移动部分，为了让下次打开的时候，形状位置是移动后的位置，需要把最后的位置信息等写入数据库。

代码如下

Sub 保存问题当前位置()
    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

        Set newShape = sht.Shapes.Range(Array(shapeName))
        
        positionX = newShape.Left
        positionY = newShape.Top
        widthVal = newShape.Width
        heightVal = newShape.Height
        
        lineColorRGB = newShape.Line.ForeColor.RGB
        fillColorRGB = newShape.Fill.ForeColor.RGB
        
        ' 更新
        inputRow = i
        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
    Next
End Sub

从以上代码可以看出，该过程不是直接遍历当前图片上已有的形状，而是对数据库中信息进行遍历，获取每一个形状的名称，进而获取这个形状对象，如下代码。这里就会存在一个可能的Bug，就是之前未将数据库中所有的形状显示在图片上，这样就会查找不到对象，会报错。为了避免这种情况出现，一定要先显示所有问题，在下一节中会进行说明

Set newShape = sht.Shapes.Range(Array(shapeName))

获取每个形状对象后，再获取其位置大小颜色等信息，更新到数据库中。核心信息为形状的在VBA中的变量名称，所以在上一节中生成形状时需要将其内部名称保存到数据库

shapeName = newShape.Name
sht.Cells(inputRow, "Q").Value = shapeName