Question

我有这个代码在第2页创建形状时我在A1：A3中写东西并根据我在B1：B3中写的内容放置文本框，问题是当我删除A1的值时我想要文本框要删除，但它不会删除文本框。我也试过：Call getCaixas(Worksheets(2), Target.Address).Delete在昏暗的盒子之后作为形状。在此选项中，它确实删除了文本框，但随后所有文本框都在页面顶部创建。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        Dim box As Shape

If Target.Address = "Delete" Then getCaixas(Worksheets(2), Target.Address).Delete

    If Target.Count > 1 Or Not Sh.Index = 1 Or Len(Target) = 0 Then Exit Sub



    If Not Intersect(Target, Range("B1:B3")) Is Nothing Then
            Set box = getCaixas(Worksheets(2), Target.Offset(0, -1).Address)
            Select Case Target.Value
                Case Is = "financeiro"
                    box.Top = 20
                Case Is = "cliente"
                    box.Top = 150
                Case Is = "processos internos"
                    box.Top = 250
            End Select
        End If

        If Not Intersect(Target, Range("A1:A3")) Is Nothing Then
            Set box = getCaixas(Worksheets(2), Target.Address)
            Select Case Target.Address
                Case Is = "$A$1"
                    box.Left = 50
                Case Is = "$A$2"
                    box.Left = 200
                Case Is = "$A$3"
                    box.Left = 350
            End Select
            box.TextFrame.Characters.Text = Target.Value
        End If



    End Sub

    Function getCaixas(ws As Worksheet, CaixasName As String) As Shape
        Dim box As Shape
        On Error Resume Next
        Set box = ws.Shapes(CaixasName)
        If Err.Number <> 0 Then
            Set box = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 50)
            box.Name = CaixasName
        End If
        On Error GoTo 0
        Set getCaixas = box
    End Function

Answer 1

当您必须删除给定区域中的形状时，最简单的方法是循环形状并查看异常值。

给定工作表中的形状是一个集合。因此，循环它们很容易。每个形状都有两个重要属性 - TopLeftCell和BottomRightCell。这些属性的类型是范围 - 因此它们具有行和列属性。

长话短说 - 如果你有这样的案例：

并且您要删除range("A1:C3")之外的所有形状（黄色），然后您可以遍历每个形状并检查其TopLeftCell.Row和BottomRightCell.Column是否超过3。如果两者都是是的，然后删除它。像这样：

Sub KillShapes()

    Dim sh As Shape

    For Each sh In ActiveSheet.Shapes
        Debug.Print sh.Name
        Debug.Print sh.TopLeftCell.Address
        Debug.Print sh.BottomRightCell.Address

        If sh.TopLeftCell.Row > 3 And sh.BottomRightCell.Column > 3 Then
            Debug.Print sh.Name; " is deleted!"
            sh.Delete
        End If

    Next

End Sub

Answer 2

这看起来不对：

If Target.Address = "Delete" Then

Range对象的Address属性将返回一个范围地址，如＆＃34; $ A $ 1＆＃34;。如果正在寻找＆＃34;删除＆＃34;的单元格值那应该是

If Target.Value= "Delete" Then

如果您正在寻找命名范围的名称，那么

If Target.Name.Name = "Delete" Then

VBA删除形状

2 个答案: