Author Topic: Add a shape data row in a shape inside a container  (Read 213 times)

0 Members and 1 Guest are viewing this topic.

ltaretti

  • Newbie
  • *
  • Posts: 5
Add a shape data row in a shape inside a container
« on: February 13, 2018, 07:48:17 AM »
What's up guys?

I need to find a way to create a new shape data row in a shape that is inside a container shape. I thought and tryied use a vba code to do it but I didnt find a solution yet. I want that running a macro, the shape data of a shape add a new row called "Sector" for example, and this new row be filled with container shape name, "Sector 1" for example. Is there possible? Is there another way to do it?

Thank you in advance.

JM

  • Jr. Member
  • **
  • Posts: 15
Re: Add a shape data row in a shape inside a container
« Reply #1 on: April 12, 2018, 12:15:54 PM »

I _think_ this is what you are asking for.  I wrote this so you could, if you chose, make this a double-click action of the shape using '=CALLTHIS("GetContainerText")' method in the shape's shapesheet.  You may choose to remove that message box. 

Also note that a shape may be in more than one container.. you would need to decide what you want to do with the data in that case.. (loop over all containers and concatenate them, or something)

Code: [Select]
Public Sub GetContainerText(pCallingShape As Visio.Shape)
Dim lngShapeIDs() As Long  'This is the list of shape IDs to select
Dim vsoShape As Visio.Shape
Dim containerText As String
Dim pCellName As String: pCellName = "CONTAINER_TEXT"


    'Get the list of containers the shape belongs to (an array of ShapeIds)
    lngShapeIDs = pCallingShape.MemberOfContainers
   
    'Here, we are just going to grab the first container out of the array, but you may want to cycle through them all..
    Set vsoShape = ActivePage.Shapes.ItemFromID(lngShapeIDs(0))
    containerText = vsoShape.Text
    MsgBox ("My container's text is:" & containerText)
   
    'Put it in a shape data field of the child
    'If the Prop section isn't on the shape, then add it
    If (Not (pCallingShape.SectionExists(visSectionProp, 1))) Then
        pCallingShape.AddSection visSectionProp
    End If
   
    'If the shape data element doesnt exist, then add it:
    If (Not (pCallingShape.CellExistsU("Prop." & pCellName, Visio.VisExistsFlags.visExistsAnywhere))) Then
        pCallingShape.AddNamedRow visSectionProp, pCellName, visTagDefault
        'Set the field's label
        pCallingShape.CellsSRC(visSectionProp, visRowLast, visCustPropsLabel).Formula = Chr(34) & (pCellName) & Chr(34)
        pCallingShape.CellsSRC(visSectionProp, visRowLast, visCustPropsType).FormulaU = visPropTypeString

    End If
   
    'Modify Shapedata field and set to the container's text.  Dont forget to use CHR( 34 )'s to put it in quotes for a string
    If (Len(containerText) > 0) Then
        pCallingShape.CellsSRC(visSectionProp, visRowLast, visCustPropsValue).Formula = Chr(34) & (containerText) & Chr(34)
    End If

   
End Sub