it's manually intensive (put some user fields in the shape you want to drop
and then change some fields in the shape sheet). I'd start over here
http://msdn.microsoft.com/library/e...esigning_Text_Behavior_388.asp?frame=true#396
al
If you want to do it with code, this works for me.....
' example of dropping a shape, put text in it linked to a custom property,
make sure it behave well with
' scaling
' put a rectangle on the page
objRect = visPage.DrawRectangle(iStart, iTop, iEnd, iBottom)
' initialize the shape for text behavior ( I use the rownr as a pointer when
I want multiple lines of text based on
' custom properties)
clsVisio.TextAntiScaling(objRect, intRowNr)
' add a text field to the shape that will look at a custom property
blnResult = clsVisio.AddTextFieldToShape(objRect, _
"LocationID : ", _
"ThePage!Prop.LocationID", _
visFmtStrNormal)
' set the shape up so that it doesn't get confused about the scaling
Public Sub TextAntiScaling _
(ByVal objRect As Microsoft.Office.Interop.Visio.Shape, _
ByVal intFieldNr As Integer)
Dim objcell As Microsoft.Office.Interop.Visio.Cell
Dim blnResult As Boolean
objRect.Name = "textfield_" & CStr(intFieldNr)
blnResult = AddUserPropertyToShape(objRect, "width", "width", "width", _
objRect.Cells("Width").ResultIU, "width")
blnResult = AddUserPropertyToShape(objRect, "height", "height", "height", _
objRect.Cells("height").ResultIU, "height")
blnResult = AddUserPropertyToShape(objRect, "pinX", "pinX", "pinX", _
objRect.Cells("pinx").ResultIU, "pinX")
blnResult = AddUserPropertyToShape(objRect, "piny", "piny", "piny", _
objRect.Cells("piny").ResultIU, "piny")
objcell = objRect.Cells("width")
objcell.Formula = "user.width*(ThePage!DrawingScale/ThePage!PageScale)"
objcell = objRect.Cells("height")
objcell.Formula = "user.height*(ThePage!DrawingScale/ThePage!PageScale)"
objcell = objRect.Cells("pinx")
objcell.Formula = "user.pinx*(ThePage!DrawingScale/ThePage!PageScale)"
objcell = objRect.Cells("piny")
objcell.Formula = "user.piny*(ThePage!DrawingScale/ThePage!PageScale)"
objRect.Cells("Para.HorzAlign").Formula = visHorzLeft
End Sub
Public Function AddTextFieldToShape _
(ByVal visShape As Microsoft.Office.Interop.Visio.Shape, _
ByVal strFieldPrompt As String, _
ByVal strProperty As String, _
ByVal fldFormat As Microsoft.Office.Interop.Visio.VisFieldFormats) _
As Boolean
Dim visText As Microsoft.Office.Interop.Visio.Characters
visText = visShape.Characters
visText.Text = strFieldPrompt
' Set the character color of the text to blue.
visText.CharProps(CShort(visCharacterColor)) = CShort(visBlue)
' Set the font size of the text to 8.
visText.CharProps(CShort(visCharacterSize)) = 9
' Start a new run that will contain the appended string with
' different formatting.
visText.Begin = visText.End
' Add the field
visText.AddCustomField(strProperty, fldFormat)
' Keep the same formatting as set for the previous string,
' except set the character style to bold italic.
visText.CharProps(CShort(visCharacterStyle)) = _
CShort(visBold) + _
CShort(visItalic)
' Set the character color
visText.CharProps(CShort(visCharacterColor)) = CShort(visBlack)
Return True
End Function
' add a user property row to a shape
Public Function AddUserPropertyToShape _
(ByVal visShape As Microsoft.Office.Interop.Visio.Shape, _
ByVal strLocalRowName As String, _
ByVal strRowNameU As String, _
ByVal strLabelName As String, _
ByVal strValue As String, _
Optional ByVal strPrompt As String = "") _
As Boolean
Dim vsoCell As Microsoft.Office.Interop.Visio.Cell
Dim intRowIndex As Integer
If visShape.SectionExists(visSectionUser, False) = False Then
visShape.AddSection(visSectionUser)
End If
' get an available row number
intRowIndex = visShape.AddNamedRow(visSectionUser, _
strLocalRowName, _
Visio.VisRowIndices.visRowUser)
' add a prompt
vsoCell = visShape.CellsSRC(visSectionUser, _
visRowUser + intRowIndex, visUserPrompt)
SetCellValueToString(vsoCell, strPrompt)
If (strLocalRowName <> strRowNameU And _
Len(strRowNameU) > 0) Then
vsoCell.RowNameU = strRowNameU
End If
' add a value
vsoCell = visShape.CellsSRC(visSectionUser, _
visRowUser + intRowIndex, visUserValue)
SetCellValueToString(vsoCell, strValue)
AddUserPropertyToShape = True
End Function
