Как программно сгруппировать набор фигур в excel 2007 vba?

Я перебираю данные на листе Electrical Tables и создаю фигуры на листе Shape. После создания фигур я хотел бы программно сгруппировать их. Однако я не могу понять правильный синтаксис. Фигуры есть, выбраны, и если я нажму кнопку группы, они отлично группируются. Однако со следующим кодом я получаю

Ошибка выполнения 438 Объект не поддерживает этот метод или свойство.

Я основываю этот код на примерах VBA из Интернета - я не сильный программист VBA. Как правильно это сделать? Я работаю с Excel 2007, и смена версий Excel невозможна.

Проблемный фрагмент:

Set shapeSheet = Worksheets("Shapes")

With shapeSheet
    Selection.ShapeRange.Group.Select
End With

Контекст:

Dim shapeSheet As Worksheet
Dim tableSheet As Worksheet
Dim shpGroup As Shape

Set shapeSheet = Worksheets("Shapes")
Set tableSheet = Worksheets("Electrical Tables")


With tableSheet
    For Each oRow In Selection.Rows
            rowCount = rowCount + 1
            Set box1 = shapeSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50 + ((rowCount - 1) * 14), 115, 14)
            box1.Select (False)
            Set box1Frame = box1.TextFrame
            Set box2 = shapeSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 165, 50 + ((rowCount - 1) * 14), 40, 14)
            box2.Select (False)
            Set box2Frame = box2.TextFrame
     Next
End With

Set shapeSheet = Worksheets("Shapes")

With shapeSheet
    Selection.ShapeRange.Group.Select
End With

shapes excel vba
person Andrew Bucknell    schedule 05.06.2011    source источник

Ответы (5)


arrow_upward
7
arrow_downward

Это сработало для меня в Excel 2010:

Sub GroupShapes()

    Sheet1.Shapes.SelectAll
    Selection.Group

End Sub

У меня было две фигуры на листе 1, которые были разгруппированы перед вызовом метода выше и сгруппированы после.

Редактировать

Чтобы выбрать определенные фигуры с помощью индексов:

Sheet1.Shapes.Range(Array(1, 2, 3)).Select

Использование имен:

Sheet1.Shapes.Range(Array("Oval 1", "Oval 2", "Oval 3")).Select
person Nick Spreitzer    schedule 05.06.2011
comment
Спасибо за указатель. Selection.Group, похоже, ничего не делает в Excel 2007. На листе формы уже могут быть другие фигуры, поэтому вызов SelectAll бесполезен. - person Andrew Bucknell; 06.06.2011
comment
@Эндрю, странно, что Group не работает в Excel 2007. Мне нужно будет проверить это завтра, когда я буду на работе. (У меня есть Office 2007.) Кроме того, SelectAll был для меня просто быстрым способом выбора нескольких фигур. В вашей ситуации вы хотели бы использовать свойство Range объекта Shapes. Я обновлю свой ответ... - person Nick Spreitzer; 06.06.2011
comment
@ Эндрю: на самом деле: посмотри ответ Криса Нильсена. Это идеально подходит для того, что вы делаете. Просто замените Box1.Name вашими переменными TextBox (сколько бы их ни было), и все будет хорошо. - person Nick Spreitzer; 06.06.2011
comment
(Приведенный выше комментарий предполагает, что вы смогли заставить работать метод Group.) - person Nick Spreitzer; 06.06.2011
comment
Спасибо, Ник, мне не хватило того, чтобы сделать shapeSheet.Activate, прежде чем пытаться работать с Selection for the Sheet. Группа работает - спасибо, что показали мне правильный синтаксис. - person Andrew Bucknell; 06.06.2011

arrow_upward
11
arrow_downward

Не нужно сначала выбирать, просто используйте

Set shpGroup = shapeSheet.Shapes.Range(Array(Box1.Name, Box2.Name)).Group

PS. причина, по которой вы получаете ошибку, заключается в том, что объект выбора указывает на все, что выделено на листе (что не будет только что созданными фигурами), скорее всего, Range и Range не имеют свойства Shapes. Если бы у вас были другие фигуры на листе, и они были выбраны, то они были бы сгруппированы.

person chris neilsen    schedule 05.06.2011
comment
Забавно: я думал, что пробовал это, и это не сработало. Я ошибался. Дох. +1 - person Nick Spreitzer; 06.06.2011
comment
Уродливо, но кажется единственным способом создать ShapeRange. - person Tuntable; 08.11.2018

arrow_upward
3
arrow_downward

Вот как можно легко сгруппировать ВСЕ фигуры на листе, не требуя от вас Select каких-либо действий:

ActiveSheet.DrawingObjects.Group

Если вы думаете/знаете, что на вашем текущем листе уже есть группы для каких-либо фигур, то вам нужно сначала Ungroup этих фигур:

ActiveSheet.DrawingObjects.Ungroup  'include if groups already exist on the sheet
ActiveSheet.DrawingObjects.Group

Я знаю, что этот ответ немного не по теме, но добавил его, так как все поисковые запросы по группировке фигур Excel, как правило, указывают на этот вопрос

person Marcucciboy2    schedule 09.08.2019

arrow_upward
1
arrow_downward

У меня была та же проблема, но мне нужно было выбрать пару фигур (ранее созданных макросом и перечисленных в массиве фигур), но не «select.all», потому что на слайде могут быть другие фигуры.

Создание шейп-диапазона было непростым делом. Самый простой способ - просто просмотреть объекты формы (если вы их уже знаете) и выбрать их, имитируя «удерживая нажатой клавишу Ctrl» с опцией «Replace: = False».

Итак, вот мой код:

For ix = 1 To x
    bShp(ix).Select Replace:=False
Next
ActiveWindow.Selection.ShapeRange.Group

Надеюсь, это поможет, Керри.

person Kerry    schedule 10.05.2012
comment
Спасибо, Керри! Но здесь spreadsheet1.com/how-to-group-shapes.html Я нашел более простое решение для произвольного количества фигур - без каких-либо выборок - person Leon Rom; 10.02.2018

arrow_upward
1
arrow_downward

Я вижу здесь много решений, но я хотел бы поделиться с вами своим способом справиться с этой темой, не зная имени или номера фигуры и не используя ActiveSheet или Select.

Приведенный ниже код сгруппирует каждую фигуру на заданном листе.

Dim arr_txt() As Variant
Dim ws As Worksheet
Dim i as Long

set ws = ThisWorkbook.Sheets(1)

With ws
    ReDim arr_txt(1 To .Shapes.Count)
    For i = 1 To .Shapes.Count
        arr_txt(i) = i 'or .Shapes(i).Name
    Next
    .Shapes.Range(arr_txt).Group
End With
person Teamothy    schedule 18.03.2020
comment
Я проголосовал за ваше решение, потому что оно не зависит от тяжелого Select - person George Robinson; 21.12.2020