T
Tristan
I am trying to take the contents of a group and place them in an
array.
However to date I have not been able to either dump the array of
shapes in the group into an array, or iterate through the items in the
group putting each item into the array.
Any help would be great.
Once I have stored the contents/names of the group items in an array I
will be ungrouping them to allow me to make a change to the colour of
the font in one item and then regrouping.
Eg.
Sub reGroupobjects(itemToChange As String, colour As Integer,
selctionName as string)
Dim menuArray() As String ' This should be the Array of objects
menuArray() = 'Before ungrouping I need to get the names of the
objects into an array
ActiveSheet.Shapes(selctionName).Ungroup.Select
ActiveSheet.Shapes(itemToChange).Select
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = colour
End With
ActiveSheet.Shapes.Range(menuArray()).Select
Selection.ShapeRange.Group.Select
Selection.Name = selctionName
End Sub
Thanks in advance
Tristan
array.
However to date I have not been able to either dump the array of
shapes in the group into an array, or iterate through the items in the
group putting each item into the array.
Any help would be great.
Once I have stored the contents/names of the group items in an array I
will be ungrouping them to allow me to make a change to the colour of
the font in one item and then regrouping.
Eg.
Sub reGroupobjects(itemToChange As String, colour As Integer,
selctionName as string)
Dim menuArray() As String ' This should be the Array of objects
menuArray() = 'Before ungrouping I need to get the names of the
objects into an array
ActiveSheet.Shapes(selctionName).Ungroup.Select
ActiveSheet.Shapes(itemToChange).Select
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = colour
End With
ActiveSheet.Shapes.Range(menuArray()).Select
Selection.ShapeRange.Group.Select
Selection.Name = selctionName
End Sub
Thanks in advance
Tristan