How to find and set properties of shapes

Get and set the sizes of shapes

 

[Shape Width]

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth)

Return: String (e.g. "10 mm")

 

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = String

 

Shape.Cells("Width")

Return:Double

 

Shape.Cells("Width") = Double

 

[Shape Height]

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight)

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = Double

 

[PinX (Horizontal Position of the center of the shape)]

Shape.Cells("PinX")

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX)

 

Shape.Cells("PinX") = Double

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = Double

 

[PinY (Vertical Position of the center of the shape)]

Shape.Cells("PinY")

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY)

 

Shape.Cells("PinY") = Double

Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = Double

 

[Font Size]

Shape.CellsSRC(visSectionCharacter, 0, visCharacterSize)

Shape.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = String (e.g. "1 mm")

 

[Font Color]

Shape.CellsSRC(visSectionCharacter, 0, visCharacterColor)

Shape.CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = String (e.g. "THEMEGUARD(RGB(255,0,0))")

 

[Line BeginX, BeginY, EndX, EndY]

Shape.Cells("BeginX")

Shape.Cells("BeginY")

Shape.Cells("EndX")

Shape.Cells("EndY")

Return: Double

 

Shape.Cells("BeginX") = Double

Shape.Cells("BeginY") = Double

Shape.Cells("EndX") = Double

Shape.Cells("EndY") = Double

 

[Line Pattern]

Shape.CellsSRC(visSectionObject, visRowLine, visLinePattern)

1: Solid

2: Long-Dash

9: Dash

Return: Integer(e.g. 1)

 

Shape.CellsSRC(visSectionObject, visRowLine, visLinePattern) = Integer

 

[Line Weight]
Shape.CellsSRC(visSectionObject, visRowLine, visLineWeight)

Return: String (e.g. "1.5 pt")

 

Shape.CellsSRC(visSectionObject, visRowLine, visLineColor) = String (e.g. "1.5 pt")

 

[Line Rounding]

Shape.CellsSRC(visSectionObject, visRowLine, visLineRounding)

Return: String (e.g. "3 mm")

 

Shape.CellsSRC(visSectionObject, visRowLine, visLineRounding).FormulaU =String (e.g. "3 mm")

 

Sample Code - Get the properties of the first shape selected and apply them to the other selected shapes

Sub setSamePropertyOfPrimaryShape()
 Dim vsoSelection As Visio.Selection
 Dim primaryShape As Visio.Shape 'first selected shape
 Dim targetShape As Visio.Shape 'other selected shapes
 Dim primaryShapePropsCount As Integer ' the number of properties of primaryShape
 Dim PropArray() As Variant ' array to strage properties

 Set vsoSelection = ActiveWindow.Selection 'current selection
 Set primaryShape = vsoSelection.PrimaryItem 'set the first selected shape
 primaryShapePropsCount = primaryShape.RowCount(Visio.visSectionProp)

 With primaryShape

       'Check if primaryShape has a property section

  If .SectionExists(visSectionProp, 0) = False Then Exit Sub

  ReDim PropArray(primaryShapePropsCount, 9)
  For i = 0 To primaryShapePropsCount - 1
   PropArray(i, 1) = .Section(visSectionProp).Row(i).NameU
   PropArray(i, 2) = .CellsSRC(visSectionProp, i, visCustPropsLabel).FormulaU
   PropArray(i, 3) = .CellsSRC(visSectionProp, i, visCustPropsType).FormulaU
   PropArray(i, 4) = .CellsSRC(visSectionProp, i, visCustPropsFormat).FormulaU
   PropArray(i, 5) = .CellsSRC(visSectionProp, i, visCustPropsLangID).FormulaU
   PropArray(i, 6) = .CellsSRC(visSectionProp, i, visCustPropsCalendar).FormulaU
   PropArray(i, 7) = .CellsSRC(visSectionProp, i, visCustPropsPrompt).FormulaU
   PropArray(i, 8) = .CellsSRC(visSectionProp, i, visCustPropsValue).FormulaU
   PropArray(i, 9) = .CellsSRC(visSectionProp, i, visCustPropsSortKey).FormulaU
  Next
 End With


 For Each targetShape In vsoSelection
  With targetShape
   For i = 0 To primaryShapePropsCount - 1

           'Check if the targetShape has a property that begins with Prop.

   If .CellExists("Prop." & PropArray(i, 1), 0) = False Then

              'If not, add a new row for the property
    n = .AddRow(visSectionProp, visRowLast, visTagDefault)
   End If

           'Check if the name of the property is the same one as primaryShape
   If .Section(visSectionProp).Row(i).NameU = PropArray(i, 1) Then

               'Apply the properties of primaryShape to the target shape
    .Section(visSectionProp).Row(i).NameU = PropArray(i, 1)
    .CellsSRC(visSectionProp, i, visCustPropsLabel).FormulaU = PropArray(i, 2)
    .CellsSRC(visSectionProp, i, visCustPropsType).FormulaU = PropArray(i, 3)
    .CellsSRC(visSectionProp, i, visCustPropsFormat).FormulaU = PropArray(i, 4)
    .CellsSRC(visSectionProp, i, visCustPropsLangID).FormulaU = PropArray(i, 5)
    .CellsSRC(visSectionProp, i, visCustPropsCalendar).FormulaU = PropArray(i, 6)
    .CellsSRC(visSectionProp, i, visCustPropsPrompt).FormulaU = PropArray(i, 7)
    .CellsSRC(visSectionProp, i, visCustPropsValue).FormulaU = PropArray(i, 8)
    .CellsSRC(visSectionProp, i, visCustPropsSortKey).FormulaU = PropArray(i, 9)
   End If
  Next
  End With
 Next
End Sub