Yeah. I hate programming.
So, the goal is to add text to a shape, similar to Insert>Field>custom formula, using vba. The Text Field Section won't be present initially. The code I tried to run is:
If Not shape.SectionExists(visSectionTextField, False) Then
shape.AddSection (visSectionTextField)
shape.AddRow visSectionTextField, visRowTextField, 0
shape.CellsSRC(visSectionTextField, 0, visFieldFormat).FormulaForceU = "FIELDPICTURE(0)"
End If
shape.CellsSRC(visSectionTextField, 0, visFieldCell).FormulaForceU = "My text based on formula"
Everything runs fine. The Text Field section is created, the Format, and Value cells populated as desired. But nothing displays.
So, I'm thinking I'm on the wrong approach...suggestions???
Wapperdude
OK, I solved my problem...macro recorder to the rescue. :P The key steps are these:
Dim vsoCharacters2 As Visio.Characters
Set vsoCharacters2 = Application.ActiveWindow.Selection.Item(1).Characters
vsoCharacters2.Begin = 0
vsoCharacters2.End = 0
vsoCharacters2.AddCustomFieldU """MYTEXT""", visFmtNumGenNoUnits
So why does this work??? For that matter, what is it doing?
Wapperdude
Visio actually stores the 'text field' in a series of shapesheet rows in the 'characters section', maybe this will help
http://blogs.msdn.com/b/visio/archive/2006/08/18/running-with-characters.aspx
al
Thanks Al. I believe I've seen this. Unfortunately, something's changed, and I cannot see the pictures.
But, not sure I follow your comment. My understanding is that whatever is displayed, shows up in the shapesheet Text Fields Section, value cell, not in the Characters section. Certainly, that's what I see. What I remember about the Characters section is that if there are varying formats to the text, e.g., char size, font type, etc., there will be an added row for each variation.
The code I show from the macro recorder seems to only impact the Text Field section, i.e., it adds it, populates the format and value cells as desired. Doesnot seem to affect the chars section. Although, there could be "behind the scenes" stuff going on. It just seems strange that the more straight forward approach of adding the Text Fields section fails, but the adding of custom fields to the character (object???) does same thing. That's not obvious to me!!! That's why I hate coding. Programmers live in a world stranger than Wayne's! ;)
Wayne
aka Wapperdude
Decided to have some fun with shape text vs field inserted text, and then examine the shapesheet entries. All entries are done manually, no coding used. Shape text, i.e., select a shape and then type, is a lot more friendly. Field text is convenient if you have formulas which controls what text is displayed. But, what about formatting? Well, shape text is clearly much easier to manipulate, but, with effort, so is field text. Much more effort! Finally, you can have combinations of both. See attached.
But, none of this explains the code which spawned this post.
Wapperdude
If I'm reading it correctly the code nibblet selects the first row in the 'character section', sets the start and stop position to the 0 (making the existing text 0 length) and then inserts the custom field data. This probably has a reset action on the entire text field by replacing it with the 'field data' which appears to be the string "mytext". Regarding the text not showing, I vaguely remember going through that pain and discovering that the 'field data' string required a special character as a preface (it was a couple of years ago).
al
Pain! You got that right!!!
It took a lot of effort, i.e., googling/searching, to figure out the wrong way to do it, only to not have it work. >:( Then, practicing what I preach, ran macro recorder. Boy, did that save effort. Seems that this Text Field process could be so much easier, and a lot more obvious. I guess the internal Visio hooks aren't there if you add Text Field programmatically, so that's why the start/stop positions must be set, I guess. Still not obvious why one would resort to "addCustomField" to (a) insert the Text Field section, and then (b) to populate that section.
Anyway, did you ever get that "special" character approach to work, or did you move on to doing this way that works?
Thanks for the explanation. It helps.
Have a great Memorial Day weekend!
Wapperdude
I compared the XML after applying shape.AddSection (visSectionTextField) and vsoCharacters2.AddCustomFieldU.
Sections <Field> are no different.
But in the second case there is an additional section <Text><fld IX='0'>MYTEXT</ fld></ Text>
If you observe the Custom Fields section and cells, afaik there's no information there, where the custom field is, e.g. at what character position in the field is inserted. But that information must come from somewhere....
"My Text with a field [here] and anoter [here]." Position 22 and 35 in this example.
Decided to update the code shown at the beginning of this post:
Sub addFieldSection()
Dim vsoShp As Visio.Shape
Dim vsoChars As Visio.Characters
Set vsoShp = ActiveWindow.Selection.Item(1)
If Not vsoShp.SectionExists(visSectionTextField, False) Then
vsoShp.AddSection (visSectionTextField)
'Next two lines are not needed. Last code line makes these redundant
' .AddRow visSectionTextField, visrowtextfield, 0
' .CellsSRC(visSectionTextField, 0, visFieldFormat).FormulaForceU = "FIELDPICTURE(0)"
End If
Set vsoChars = vsoShp.Characters
vsoChars.Begin = 0
vsoChars.End = 0
vsoChars.AddCustomFieldU """MYTEXT""", visFmtNumGenNoUnits 'this populates both format, value cells.
End Sub
Took another look at the code, and further simplified it:
Sub addFieldTxt()
Dim shp As Visio.Shape
Dim vChars1 As Visio.Characters
Set shp = ActiveWindow.Selection(1)
If Not shp.SectionExists(visSectionTextField, False) Then
Set vChars1 = shp.Characters
vChars1.Begin = 0
vChars1.End = 0
vChars1.AddCustomFieldU Chr(34) & "NewText" & Chr(34), visFmtNumGenNoUnits
End If
End Sub
Your project could evolve towards 2 directions:
1. sub routines with parameters to customize the "insertion" so as to use it from other code
2. a form to use it as gui
Options:
- create or overwrite
- insert
- static text
- fields - arbitrary chosen and sorted in the order they are chosen
- complex formulas ( "str(2*user.val) & prop.name" )
- define separators (line break, slashes, commas, etc.
- define the target
- selection
- sub-selection(?)
- criteria driven
- eg all shapes where prop.field = soAndSo
- crazier (but useful): inspect the connections --> and insert linkedShape!prop.val
I know it is not what your initial goal was - just giving you some inspiration in these confinement times ;) .
Cheers, Y.
@Yacine: LOL. Glad your sense of humor has survived the CV19 isolation. Ummmm. Yes, I suppose I could do that. But, no. I set a very low goal and met it. Why would I want to go and spoil such a successful adventure?
Hope you're well thru all of this stuff. The natives over here are getting restless. Fortunately, the isolation restrictions are starting to be softened a little. Now, if only the virus itself would go away.
I use this macro to recreate textfield sections. In this case, I'm passing in an Access recordset and shape.
Public Sub Update_visSectionTextField( _
new_rst As ADODB.Recordset, _
vsoShape As Visio.Shape)
On Error GoTo visSectionTextField_Err
'// Set Text Transform Section Cell Values
If vsoShape.CellExists("Prop." & C_SHAPE_TYPE, 0) Then
If vsoShape.SectionExists(visSectionTextField, visExistsAnywhere) Then
vsoShape.DeleteSection visSectionTextField
End If
vsoShape.AddSection visSectionTextField
vsoShape.AddRow visSectionTextField, visRowFirst, visTagDefault
vsoShape.CellsSRC(visSectionTextField, 0, visFieldFormat).FormulaForceU = "=FIELDPICTURE(0)"
vsoShape.CellsSRC(visSectionTextField, 0, visFieldCell).FormulaForceU = "=" & new_rst("CellValue")
'// Set Character Section Cell Values
vsoShape.CellsSRC(visSectionCharacter, 0, visCharacterSize).formula = "=8 pt"
vsoShape.CellsSRC(visSectionCharacter, 0, visCharacterFont).formula = "=21"
'// Set Text Block Section Cell Values
vsoShape.Cells("LeftMargin").formula = "=4 pt"
vsoShape.Cells("RightMargin").formula = "=4 pt"
vsoShape.Cells("TopMargin").formula = "=4 pt"
vsoShape.Cells("BottomMargin").formula = "=4 pt"
End If
exitvisSectionTextField:
Exit Sub
visSectionTextField_Err: ' Error-handling routine.
MsgBox Err.Description, vbCritical, "Update_visSectionTextField Error"
Resume exitvisSectionTextField
End Sub
Taking inspiration where one finds it, after looking at OldScool1948's code, I thought, there must be a simpler way...somehow leverage the two approaches... Viola!. This is about as simple as it gets.
Sub addFieldTxt()
Dim shp As Visio.Shape
Set shp = ActiveWindow.Selection(1)
If Not shp.SectionExists(visSectionTextField, False) Then
shp.Characters.AddCustomFieldU Chr(34) & "NewFieldText" & Chr(34), visFmtNumGenNoUnits
End If
Note, it's possible to pass more than just text. For example, the following would pass the result of the "Len" function:
[color=blue]shp.Characters.AddCustomFieldU Chr(34) & Len("NewFieldText") & Chr(34), visFmtNumGenNoUnits[/color]
End Sub
Why do I hear Yacine chuckling???
Well, decided to expand the little code snippet to show how to add multiple lines to be displayed in a shape. Not just Field inserted text, but a mixture of regular shape text and field text. Field text is more challenging because it has specific Visio defined formatting. Yuck. Yikes.
Anyway, here's the code:
Sub addFieldTxt()
Dim shp As Visio.Shape
Dim vChar1 As Visio.Characters
Dim lstChr As Integer
Set shp = ActiveWindow.Selection(1)
If Not shp.SectionExists(visSectionTextField, False) Then
shp.Characters.AddCustomFieldU Chr(34) & "NewFieldText" & Chr(34), visFmtNumGenNoUnits
End If
'The next 2 sections show two methods of adding additional lines.
'Both lines show the same info: the name of the shape.
'The 1st use text entry, the 2nd uses AddFieldEx
lstChr = Len(shp.CellsSRC(visSectionTextField, 0, visFieldValue).ResultStr(visNone))
Set vChar1 = shp.Characters
vChar1.Begin = lstChr 'sets reference at end of string
vChar1.End = lstChr
vChar1.Text = "" & Chr(10) & "" 'sets new line
vChar1.Begin = lstChr + 1 'sets reference at beginning of new line
vChar1.End = lstChr + 1
vChar1.Text = shp.Name 'adds shape name on the 2nd line as normal shape text
lstChr = lstChr + 1 + Len(shp.Name)
vChar1.Begin = lstChr 'increments to end of 2nd line
vChar1.End = lstChr
vChar1.Text = "" & Chr(10) & ""
vChar1.Begin = lstChr + 1
vChar1.End = lstChr + 1
'This next line adds the shape name as Field Text:
vChar1.AddFieldEx visFCatObject, visFCodeObjectName, visFmtStrNormal, 1033, 0
End Sub