如何检查是否存在任何形状？

Question

如何检查工作表中是否存在任何形状？

我用下面的代码：

Sub my()
    Dim shp As Shape
    If Not shp Is Nothing Then
        For Each shp In Sheet1.Shapes
            mesage = shp.TopLeftCell.Address(0, 0)
        Next shp
    Else
        mesage = Sheet1.Cells(1, 12).Address
    End If

End Sub

由于我没有给出形状名称，因此它正在执行“ If-else”循环的“ else”部分。

我不能在这里给出形状名称，因为每次形状名称都不相同。

Answer 1

检查是否存在任何形状

如果要检查是否有任何 VBA形状活动工作表上，那么你可以简单地检查的价值.Count属性的的Shapes对象：

ActiveSheet.Shapes.Count

...这将返回形状的数量，如果没有则返回零。

示例用法：

If ActiveSheet.Shapes.Count = 0 Then MsgBox "No shapes found!"

检查特定形状是否存在

如果您需要检查特定形状是否存在，请使用此函数：

Function shapeExists(shapeName As String) As Boolean
'returns TRUE if a shape named [ShapeName] exists on the active worksheet
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
         If sh.Name = shapeName Then shapeExists = True
    Next sh
End Function

用法示例：

If Not shapeExists("My Shape Name") Then MsgBox "Shape not found!"

列出所有形状

在“立即”窗口中列出活动工作表上的所有形状。（点击Ctrl+G打开它。）

Sub ListAllShapes()
'list all shapes on the active worksheet
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        Debug.Print "id=" & sh.ID, "name=" & sh.Name
    Next sh
End Sub

删除所有形状

从活动工作表中删除所有形状。

Sub DeleteAllShapes()
'delete all shapes on the active worksheet (Including CONTROLS, so use with caution!)
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next sh
End Sub

更多信息：

有关使用 VBA 形状的更多详细信息和示例，请参阅我对其他形状相关问题的回答（包括只是另一种形状的控件）：

• 粘贴的形状不被视为“最新”形状
• 根据单元格值更改excel中的弧长
• 无法将项目添加到组合框形状
• Excel 中表单控件和 ActiveX 控件之间的差异概述
• 如何在用户窗体上使用带有选项按钮控件的事件
• 如何禁用形状的右键单击菜单