Returning Shapes to Default in Excel

Question

I have around 70 shapes in a planning document i use for work, everything is fine but i am trying to add a new feature. These shapes are changed using edit points each week to show up on a map, but sometimes shape "A" may not get used in which i just want to turn it back to a default size along with all the other shapes. Does anyone know how i could achieve this via a Macro, i have tried lots of things and searched everywhere but i am at my wits end...

If a shape is not default, set all non default shapes to default size.

Thanks in advance

Answer 1

I don't know where Excel stores the default height and width for shapes. I assume by default you mean the size of the shape when you click to place rather than drag to size. Ovals, for instance, are 72x72. Same for squares.

One way you could do this is use the AlternativeText property of the shape. You could store the default sizes in this property. Right click on the shape, choose Format Autoshape, go to the Web tab, and type 72|72. I'm using the pipe as a delimiter between width and height. You'd have to figure out what the default size is for every type of shape you have, but like I said I don't know where Excel stores it. Once you have the AlternativeText property set, you could use code like the below

Sub FixShape()

    Dim shp As Shape
    Dim vaDefault As Variant

    Const sDELIM = "|"

    For Each shp In Sheet1.Shapes
        If Len(shp.AlternativeText) > 0 Then
            vaDefault = Split(shp.AlternativeText, sDELIM)
            shp.Width = vaDefault(0)
            shp.Height = vaDefault(1)
        End If
    Next shp

End Sub

This will set every shape that has something in AlternativeText to the width and height you recorded. This assume you're not using AlternativeText for something else.

If you don't want to use AlternativeText to store it, you could hardcode the values in VBA

Sub FixShape2()

    Dim shp As Shape

    Const lDEFOVALHEIGHT As Long = 72
    Const lDEFOVALWIDTH As Long = 72
    Const lDEFSQRHEIGHT As Long = 72
    Const lDEFSQRWIDTH As Long = 72

    For Each shp In Sheet1.Shapes
        Select Case shp.AutoShapeType
            Case msoShapeOval
                shp.Height = lDEFOVALHEIGHT
                shp.Width = lDEFOVALWIDTH
            Case msoShapeRectangle
                shp.Height = lDEFSQRHEIGHT
                shp.Width = lDEFSQRWIDTH
        End Select
    Next shp

End Sub