Возврат фигур к значениям по умолчанию в Excel

Возврат фигур к значениям по умолчанию в Excel

У меня около 70 фигур в документе планирования, который я использую для работы, все в порядке, но я пытаюсь добавить новую функцию. Эти фигуры изменяются с помощью точек редактирования каждую неделю, чтобы отобразиться на карте, но иногда фигура "A" может не использоваться, и я просто хочу вернуть ее к размеру по умолчанию вместе со всеми другими фигурами. Кто-нибудь знает, как мне добиться этого с помощью макроса? Я перепробовал много всего и искал везде, но я в тупике...

Если фигура не является фигурой по умолчанию, установите для всех фигур, не являющихся фигурами по умолчанию, размер по умолчанию.

заранее спасибо

решение1

Я не знаю, где Excel хранит высоту и ширину по умолчанию для фигур. Я предполагаю, что под значением по умолчанию вы подразумеваете размер фигуры, когда вы щелкаете, чтобы разместить, а не перетаскиваете, чтобы изменить размер. Овалы, например, имеют размер 72x72. То же самое и для квадратов.

Один из способов сделать это — использовать свойство AlternativeText фигуры. Вы можете сохранить размеры по умолчанию в этом свойстве. Щелкните правой кнопкой мыши по фигуре, выберите Format Autoshape, перейдите на вкладку Web и введите 72|72. Я использую вертикальную черту в качестве разделителя между шириной и высотой. Вам придется выяснить, какой размер по умолчанию для каждого типа фигуры, но, как я уже сказал, я не знаю, где Excel его хранит. После того, как вы установили свойство AlternativeText, вы можете использовать код, подобный приведенному ниже.

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

Это установит каждую фигуру, которая имеет что-то в AlternativeText, на ширину и высоту, которые вы записали. Это предполагает, что вы не используете AlternativeText для чего-то еще.

Если вы не хотите использовать AlternativeText для хранения, вы можете жестко закодировать значения в 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

Связанный контент