Copy container including member shapes

Started by Thomas Winkel, November 12, 2020, 01:13:54 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Thomas Winkel

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

Yacine

Yacine

Thomas Winkel

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