VBA-delete shapes | 易学教程

问题

I have this code that creates shapes in page 2 when I write something in A1:A3 and places the textbox according to what I write in B1:B3, the problem is that when I delete the value of A1 I want the textbox to be deleted, but it doesn't delete the textbox. I also tried : Call getCaixas(Worksheets(2), Target.Address).Delete after dim box as shape. In this option it did erase the textbox but then all the textboxes were created on the top of the page.

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

回答1:

When you have to delete shapes in a given area, the easiest way to do it, is to loop over the shapes and to see the outliers.

The shapes in a given sheet are a collection. Thus, looping through them is easy. Each shape has two important properties - TopLeftCell and BottomRightCell. These properties are of type range - thus they have row and column property.

Long story short - if you have a case like this:

and you want to delete every shape outside the range("A1:C3") (in yellow) then you can loop through every shape and check its TopLeftCell.Row and BottomRightCell.Column for being more than 3. If both are true, then delete it. Like this:

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