У меня около 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