完成编辑后,如何以编程方式/自动更改Visio形状文本的文本格式? [英] How do I programmatically/automatically change the text formatting for the text of a Visio shape after I am done with the editing?

查看:958
本文介绍了完成编辑后,如何以编程方式/自动更改Visio形状文本的文本格式?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

这是我想要的东西:
我想使用Visio来记录一个项目。我有一些包含代码示例的Visio文本框。
代码示例中有注释。评论是行评论(行以#开头,或者是以#开头的行末尾的位置

我需要的是让Visio更改评论在完成了该形状的编辑(文本正方形)后,自动进行另一种颜色。



从我读到的内容可以通过以下方式实现:



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



- 功能名称应该阅读形状的文字,并在每行上搜索#,并将该行的文本转换为灰色,直到行尾。



你能否确认我是否正确的路径?
我是一个全新的Visio和VBA的初学者
为了测试上面我使用了一个应该移动形状的宏编辑完成



Sub Macro()

 '启用图服务
Dim DiagramServices As Integer
DiagramServices = Active Document.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140

ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(88),visSelect
应用程序。 ActiveWindow.Selection.Move 0.5,0#


'恢复图服务
ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub



而TheText事件单元格则为= CALLTHIS(ThisDocument.Macro)



一旦完成编辑,我预计形状向右移动,但没有发生
我做错了什么?



感谢很多
P

解决方案

尝试这个子,这不是很好您需要将代码添加到VBA编辑器中的ThisDocument模块中(按Alt + F11打开它)。



p>

实际上,TheText()事件不会调用fo完成文本编辑后,将会修改文本:在修改文本时(只要按下一个键,格式化或调整文本大小),这将是非常低效的。



我将使用另一个事件,如EvntDoubleClick()或者用户定义的菜单选项j来调用changeColor子。

  Sub changeColor(oShape As Visio.Shape)

错误GoTo Err_changeColor

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

设置oShpChar = oShape.Characters

iLength = oShpChar.CharCount

'主循环:我们浏览所有选择要素的文本以更改
Do
'查找下一个#字符的位置
iBeginOffset = InStr(oShpChar.Text,#)
如果iBeginOffset = 0然后退出Do'#Not found - >结束循环

'查找下一个LF的位置,以更改颜色,直到行的结尾
iEndOffset = InStr(iBeginOffset,oShpChar.Text,vbLf)
如果iEndOffset = 0然后iEndOffset = iLength - oShpChar.Begin'如果没有找到,更改所有

'更新部分更改
oShpChar.End = oShpChar.Begin + iEndOffset'我们使用前一个开始位置加偏移
oShpChar.Begin = oShpChar.Begin + iBeginOffset - 1'Idem。我们想改变#的颜色,因此(-1)

'将所选文本的颜色(从开始到结束之间)更改为绿色(9)
oShpChar.CharProps (visCharacterColor)= 9

oShpChar.Begin = oShpChar.Begin + 1'我们不想再找到相同的#,所以我们撤消上一个(-1)
oShpChar。 End = iLength'我们要继续搜索直到结束

循环While(iEndOffset<> iLength)

Exit_changeColor:

如果不是oShpChar没有设置oShpChar =没有
退出Sub

Err_changeColor:

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

End Sub


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

解决方案

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

这篇关于完成编辑后,如何以编程方式/自动更改Visio形状文本的文本格式?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆