this from the visio sdk available for free at msdn.microsoft.com
al
Private Function insertCustomPropertyField( _
ByVal vsoShapeCharacters As characters, _
ByVal strPropertyNameU As String, ByVal intFieldFormat As Integer) _
As Integer
' insertCustomPropertyField
'
' Abstract - This method inserts a custom property label and value into
shape text.
'
' Parameters
' vsoShapeCharacters Shape characters object
' strPropertyNameu Custom property cell name
' intFieldFormat VisFieldFormats value
'
' Return value Position of the last character in the inserted text
Dim intLabelBegin As Integer
Dim intLabelEnd As Integer
Dim intTextEnd As Integer
Dim strLabelNameU As String
Dim strLabel As String
Dim vsoTargetShape As Visio.shape
Dim vsoLabelCell As Cell
On Error GoTo insertCustomPropertyField_Err
' look up the label for this custom property
strLabelNameU = strPropertyNameU + ".Label"
Set vsoTargetShape = vsoShapeCharacters.shape
Set vsoLabelCell = vsoTargetShape.CellsU(strLabelNameU)
strLabel = vsoLabelCell.ResultStr(VisUnitCodes.visUnitsString)
' Add the label.
vsoShapeCharacters.Begin = vsoShapeCharacters.End
intLabelBegin = vsoShapeCharacters.Begin
vsoShapeCharacters.Text = strLabel
intLabelEnd = vsoShapeCharacters.End
' Add a tab separator between label and field
vsoShapeCharacters.Begin = vsoShapeCharacters.End
vsoShapeCharacters.Text = vbTab
' Add the custom property
vsoShapeCharacters.Begin = vsoShapeCharacters.End
vsoShapeCharacters.AddCustomFieldU strPropertyNameU, intFieldFormat
vsoShapeCharacters.Begin = vsoShapeCharacters.End
vsoShapeCharacters.Text = vbLf
intTextEnd = vsoShapeCharacters.End
' Set the label to bold and left-aligned text.
vsoShapeCharacters.Begin = intLabelBegin
vsoShapeCharacters.End = intLabelEnd
vsoShapeCharacters.CharProps(VisCellIndices.visCharacterStyle) = _
VisCellVals.visBold
vsoShapeCharacters.ParaProps(VisCellIndices.visHorzAlign) = _
VisCellVals.visHorzLeft
vsoShapeCharacters.End = intTextEnd
insertCustomPropertyField = vsoShapeCharacters.End
Exit Function