2

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

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

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

1 ответ1

0

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

Один из способов сделать это - использовать свойство AlternativeText формы. Вы можете хранить размеры по умолчанию в этом свойстве. Щелкните правой кнопкой мыши на фигуре, выберите «Формат автофигуры», перейдите на вкладку «Интернет» и введите 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

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .