Hi,
this feature was more complex than expected.
Maybe someone has an easier approach.
Demo attached.
Best regards,
Thomas
Function CopyContainer(container As Visio.Shape, page As Visio.page, xPos As Double, yPos As Double) As Visio.Shape
Dim containerDrop As Visio.Shape
Dim memberId As Variant
Dim shp As Visio.Shape
Dim shpDrop As Visio.Shape
Dim containerX As Double
Dim containerY As Double
Dim shpDropX As Double
Dim shpDropY As Double
'Drop container and correct position (Visio bug?)
Set containerDrop = page.Drop(container, xPos, yPos)
containerDrop.Cells("PinX") = xPos
containerDrop.Cells("PinY") = yPos
'Original container position
containerX = container.Cells("PinX")
containerY = container.Cells("PinY")
'Drop member shapes relative to container position and add to container
For Each memberId In container.ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
Set shp = container.ContainingPage.Shapes.ItemFromID(memberId)
shpDropX = shp.Cells("PinX") - containerX + xPos
shpDropY = shp.Cells("PinY") - containerY + yPos
Set shpDrop = page.Drop(shp, shpDropX, shpDropY)
containerDrop.ContainerProperties.AddMember shpDrop, visMemberAddDoNotExpand
Next memberId
'Return container copy
Set CopyContainer = containerDrop
End Function
Er lebt! ;) :D
Wie gehts?
Hi Yacine,
gut geht es :D danke der Nachfrage. Hoffe dir auch!
At the moment I don't work so much with Visio, so I'm not here very often.
Beste Grüße,
Thomas