r z
r z

Reputation: 99

Use Excel VBA Command to delete all shapes excluding specific ShapeTypes

I have part drawings that I mark up with welds. Each drawing is the same but has unique serial numbers. Each weld is represented by a Circle Shape (msoShapeOval). After I hit my save function, I want all Circle Shapes (and ONLY circle shapes) removed from the drawing so that I can begin the next serial number.

I tried If statements with Shape.Type commands to delete all msoShapeOval, but the file doesn't recognize the shapes.

I also tried the opposite where If Not (textbox, OLE, picture, etc) delete shape, however that deleted ALL shapes.

Sub DeleteAllWelds()
Dim shp As Shape
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")

For Each shp In ws.Shapes
    If shp.Type = msoShapeOval Then shp.Delete
Next shp

End Sub

This is the CommandButton which calls the DeleteWelds sub

Private Sub CommandButton2_Click() 'Save and create new Weld Map for same Part Number
'Remove all weld shapes 'Reset any counters 'Reset fields in UserForm1 but not all

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Call SaveDoc
    If UserForm3_Exit.Tag = "Go" Then
        ws.Range("I2, I3, A6:K80").Value = ""
        Call DeleteAllWelds
        Unload Me
    ElseIf UserForm3_Exit.Tag = "Cancel" Then
        Unload Me
    End If

End Sub

Finally the Sub which creates the Oval shapes to begin with.

Sub ShapeWithNum()
    ActiveSheet.Shapes.AddShape(msoShapeOval, 20, 40, 20, 20).Select
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = buttonCell
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .name = "+mn-lt"
    End With
End Sub

The method where I only delete msoShapeOval doesn't delete any objects, but when I use If not (mso(insert ones I need)) all objects are deleted.

Upvotes: 2

Views: 2224

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149277

You need to use shp.AutoShapeType instead of shp.Type as commented by @AhmedAU in the comments (The comment is now deleted).

There are different kinds of shapes in Excel. For example 3D model, AutoShape, Callout etc. You can get the entire list in MsoShapeType enumeration (Office)

So when you say Shape.Type, then it refers to MsoShapeType. Let's take an example. Insert these shapes in the worksheet

enter image description here

Now run this code

Sub Sample()
    Dim ws As Worksheet
    Dim Shp As Shape

    Set ws = Sheet1

    For Each Shp In ws.Shapes
        Debug.Print "(" & Shp.Name & ")"; "---"; Shp.Type
    Next Shp
End Sub

You will get this output

(Oval 1)--- 1
(TextBox 2)--- 17
(Straight Connector 4)--- 9
(Right Arrow 5)--- 1
(Explosion 1 6)--- 1

So you will notice that Oval 1, Right Arrow 5 and Explosion 1 6 have a shape type of 1. This means (if you refer to the above link) these are AutoShapes

When you Print the value of msoShapeOval in the Immediate Window using ?msoShapeOval, you will notice that the value is 9. It definitely is not 1 So what is this value? This is the Shape.AutoShapeType property which has a value of 9 for msoShapeOval

Read up on Shape.AutoShapeType property (Excel). It says Returns or sets the shape type for the specified Shape or ShapeRange object, which must represent an AutoShape other than a line, freeform drawing, or connector.

So one should know when to use the Shp.Type and when to use the Shp.AutoShapeType

Now try this code

Sub Sample()
    Dim ws As Worksheet
    Dim Shp As Shape

    Set ws = Sheet1

    For Each Shp In ws.Shapes
        Debug.Print "(" & Shp.Name & ")"; "--- Shape Type: "; Shp.Type; "--- AutoShape Type: "; Shp.AutoShapeType
    Next Shp
End Sub

You will see the output as

(Oval 1)--- Shape Type:  1 --- AutoShape Type:  9
(TextBox 2)--- Shape Type:  17 --- AutoShape Type:  1
(Straight Connector 4)--- Shape Type:  9 --- AutoShape Type: -2
(Right Arrow 5)--- Shape Type:  1 --- AutoShape Type:  33
(Explosion 1 6)--- Shape Type:  1 --- AutoShape Type:  89

So in your code, simply change

If shp.Type = msoShapeOval

to

If shp.AutoShapeType = msoShapeOval

Upvotes: 3

Related Questions