How do I programmatically/automatically change the text formatting for the text of a Visio shape after I am done with the editing?

Question

Here is what I want to achive: I want to use Visio to document a project. I have some Visio text boxes that contain code examples. The code examples have comments in them. The comments are line comments (either the line begins with # or they are places at the end of the line beginning with #

What I need is to have Visio change the comments to another color automatically after I am done with the editing of that shape (a text square).

From what I read this can be achieved with the following:

-use "TheText" event and CALLTHIS("Function-name")

-the "Function-name" procedure should read the text of the shape and search for "#" on each line and turn the text on that line to let's say "grey" till the end of the line.

Could you please confirm me if I am on the right path with this? I am a totally beginner with Visio and VBA. To test the above I used a Macro that should move the shape as soon as the editing is done

Sub Macro()

'Enable diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140

ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(88), visSelect
Application.ActiveWindow.Selection.Move 0.5, 0#


'Restore diagram services
ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

And "TheText" event cell had this =CALLTHIS("ThisDocument.Macro")

I expected the shape to move to right as soon as I was done with the editing but it did not happen What am I doing wrong?

thanks a lot P

Answer 1

The CALLTHIS shapesheet function expects that you'll have a sub/function with the name matching the first argument, obviously with dots separating the module and routine names. The second argument is the VBA project name, which is optional.

CALLTHIS also expects that your routine will have its first argument be the Visio.Shape that is firing the event, so your Sub Macro() should actually be Sub Macro(ShpObj as Visio.Shape). I think after you do that, the event should work.

Answer 2

Try this sub, it's not very well programmed, but it should do the trick.

You need to add the code to the ThisDocument module in the VBA editor (press Alt+F11 to open it).

Actually, the TheText() event won't call the formatting function AFTER you're done with the text editing: It will be called time and again while modify the text (whenever you press a key, format or resize your text box), which would be quite inefficient.

I would use another event, like EvntDoubleClick() instead, or a user defined menu optionj, to call the changeColor sub.

  Sub changeColor(oShape As Visio.Shape)

     On Error GoTo Err_changeColor

     Dim iLength As Integer
     Dim iBeginOffset As Integer, iEndOffset As Integer
     Dim oShpChar As Visio.Characters

     Set oShpChar = oShape.Characters

     iLength = oShpChar.CharCount

     ' Main loop: We go through all the text selecting the adecuate portions to change
     Do
        ' Find the position of next # character
        iBeginOffset = InStr(oShpChar.Text, "#")
        If iBeginOffset = 0 Then Exit Do    ' # Not found -> end the loop

        ' Find the position of next LF to change color only until the end of the line
        iEndOffset = InStr(iBeginOffset, oShpChar.Text, vbLf)
        If iEndOffset = 0 Then iEndOffset = iLength - oShpChar.Begin      ' If not found, change everything

        ' Update the portion to change
        oShpChar.End = oShpChar.Begin + iEndOffset          ' We use the previous beginning position plus the offset
        oShpChar.Begin = oShpChar.Begin + iBeginOffset - 1  ' Idem. We want to change #'s color, too, thus the (-1)

        ' Change color of the selected text (between Begin and End) to green (9)
        oShpChar.CharProps(visCharacterColor) = 9

        oShpChar.Begin = oShpChar.Begin + 1    ' We don't want to find the same # again, so we undo the previous (-1)
        oShpChar.End = iLength                 ' We want to continue searching until the end

     Loop While (iEndOffset <> iLength)

  Exit_changeColor:

     If Not oShpChar Is Nothing Then Set oShpChar = Nothing
     Exit Sub

  Err_changeColor:

     MsgBox Err.Number & ": " & Err.Description, vbExclamation, "Error"
     Resume Exit_changeColor

  End Sub