完成编辑后，如何以编程方式/自动更改 Visio 形状文本的文本格式？

Question

这是我想要实现的目标： 我想使用 Visio 来记录一个项目。我有一些包含代码示例的 Visio 文本框。 代码示例中包含 cmets。 cmets 是行 cmets（行以 # 开头，或者它们位于以 # 开头的行的末尾

我需要让 Visio 在完成该形状（文本正方形）的编辑后自动将 cmets 更改为另一种颜色。

根据我的阅读，这可以通过以下方式实现：

-使用 "TheText" 事件和 CALLTHIS("Function-name")

-“Function-name”程序应该读取形状的文本并在每一行搜索“#”并将该行上的文本变为“灰色”直到行尾。

您能否确认我是否走在正确的道路上？ 我完全是 Visio 和 VBA 的初学者。 为了测试上述内容，我使用了一个宏，它应该在编辑完成后立即移动形状

子宏()

'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

结束子

并且“TheText”事件单元格有这个 =CALLTHIS("ThisDocument.Macro")

我希望编辑完成后形状会向右移动，但它没有发生 我做错了什么？

非常感谢 P

Answer 1

CALLTHIS shapesheet 函数希望您有一个名称与第一个参数匹配的子/函数，显然用点分隔模块和例程名称。第二个参数是 VBA 项目名称，可选。

CALLTHIS 还希望您的例程的第一个参数是触发事件的 Visio.Shape，因此您的 Sub Macro() 实际上应该是 Sub Macro(ShpObj as Visio.Shape)。我认为在你这样做之后，该事件应该可以工作。

Answer 2

试试这个 sub，它的程序不是很好，但它应该可以解决问题。

您需要在 VBA 编辑器中将代码添加到 ThisDocument 模块（按 Alt+F11 打开）。

实际上，TheText() 事件在您完成文本编辑后不会调用格式化函数：它会在修改文本时一次又一次地调用（每当您按下某个键、格式化或调整文本大小时）框），这将是非常低效的。

我会改用另一个事件，例如 EvntDoubleClick() 或用户定义的菜单选项 j，来调用 changeColor 子。

  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