Use VBA to add Text Field to a shape

Started by wapperdude, May 24, 2014, 01:46:54 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

wapperdude

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
Visio 2019 Pro

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 2019 Pro

aledlund

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

wapperdude

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
Visio 2019 Pro

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
Visio 2019 Pro

aledlund

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

wapperdude

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
Visio 2019 Pro

Croc

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>

Jumpy

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.


wapperdude

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
Visio 2019 Pro

wapperdude

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
Visio 2019 Pro

Yacine

#11
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

wapperdude

@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.
Visio 2019 Pro

OldSchool1948

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

wapperdude

#14
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
Visio 2019 Pro