Retornando formas ao padrão no Excel

Question

Tenho cerca de 70 formas em um documento de planejamento que uso no trabalho, está tudo bem, mas estou tentando adicionar um novo recurso. Essas formas são alteradas usando pontos de edição a cada semana para aparecer em um mapa, mas às vezes a forma "A" pode não ser usada e eu só quero voltar ao tamanho padrão junto com todas as outras formas. Alguém sabe como eu poderia conseguir isso através de uma macro, eu tentei muitas coisas e procurei em todos os lugares, mas estou perdendo o juízo ...

Se uma forma não for padrão, defina todas as formas não padrão para o tamanho padrão.

desde já, obrigado

Answer 1

Não sei onde o Excel armazena a altura e largura padrão das formas. Presumo que por padrão você se refira ao tamanho da forma quando clica para posicionar em vez de arrastar para dimensionar. Os ovais, por exemplo, têm 72x72. O mesmo para quadrados.

Uma maneira de fazer isso é usar a propriedade AlternativeText da forma. Você pode armazenar os tamanhos padrão nesta propriedade. Clique com o botão direito na forma, escolha Formatar Autoshape, vá para a aba Web e digite 72|72. Estou usando o cano como delimitador entre largura e altura. Você teria que descobrir qual é o tamanho padrão para cada tipo de forma que possui, mas como eu disse, não sei onde o Excel o armazena. Depois de definir a propriedade AlternativeText, você pode usar um código como o abaixo

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

Isso definirá cada forma que tenha algo em AlternativeText com a largura e altura que você gravou. Isso pressupõe que você não esteja usando AlternativeText para outra coisa.

Se você não quiser usar AlternativeText para armazená-lo, você pode codificar os valores em 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