如何检查单元格是否包含形状？

Question

我想检查特定单元格是否具有形状，例如。 B7. 如果不存在，则在 B7 处创建新形状（B7.top、B7.left）。 如果存在，则向右移动 X 列并制作新形状

我尝试通过以下代码进行检查，但它不起作用，因为我认为它不能这样搜索：

rg = Activesheet.Range("B7")
Do While Not rg.Value = vbNullString
rg = rg.Offset(0, 6)
Loop

Answer 1

尝试一下：

Sub AddOrMoveShape()
    Dim rg As Range
    Dim shp As Shape
    Dim shapeExists As Boolean
    Dim colOffset As Integer
    
    ' Starting position
    Set rg = ActiveSheet.Range("B7")
    colOffset = 0
    
    Do
        shapeExists = False
        ' Check if a shape exists at the current cell position
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Address = rg.Offset(0, colOffset).Address Then
                shapeExists = True
                Exit For
            End If
        Next shp
        
        ' If no shape exists at the current position, create a new shape
        If Not shapeExists Then
            Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                rg.Offset(0, colOffset).Left, _
                rg.Offset(0, colOffset).Top, _
                50, 50)
            shp.Name = "MyShape" & (colOffset \ 6 + 1) ' Optional: Naming the shape
            Exit Do
        End If
       
        ' Move to the next position to the right
        colOffset = colOffset + 6
    Loop
End Sub