在Visio中查找某個字符並重新格式化以下文本

Question

由於我的某個項目使用Visio的時間很緊，我需要查看所有頁面中某些字符的所有形狀（將其命名爲「&」），然後在它後面改變n個字符的顏色，所以我寫了一個類似於下面的代碼，但它並沒有經過一個文本塊中的所有事件，它碰到第一個循環後退出......我只需要幫助來解決它我的想法現在是種凍結...如果我的問題是愚蠢的遺憾

Sub test() 
    Dim PageObj As Visio.Page 
    Dim shpsObj As Visio.Shapes 
    Dim shpObj As Visio.Shape 
    Dim oShpChar As Visio.Characters 

    Set PageObj = ActivePage 
    Set shpsObj = PageObj.Shapes 

    For Each shpObj In shpsObj 
     'Dim iLength As Integer 
     Dim iBeginOffset As Integer, iEndOffset As Integer 
     Set oShpChar = shpObj.Characters 
     Do 
      iBeginOffset = InStr(oShpChar.Text, "&test") 
      'If iBeginOffset = 0 Then Exit Do ' # Not found -> end the loop 

      iEndOffset = iBeginOffset + 3 

      oShpChar.Begin = iBeginOffset 
      oShpChar.End = iEndOffset 

      oShpChar.CharProps(visCharacterColor) = 9 

      oShpChar.Begin = oShpChar.Begin + 1 
      oShpChar.End = oShpChar.CharCount 
     Loop While (iEndOffset < oShpChar.CharCount) 
    Next 
End Sub 

我只是標記它爲Excel也因爲整個概念是相同的......

Answer 1

發現問題...

不幸的是，Microsoft Visio沒有通過外部循環保存「Character.Begin」和「Character.End」屬性的更新值，換句話說，它保留但不能被其他方法訪問作爲 「CharProps」。所以我在while循環之外引入了一個計數器來跟蹤上述屬性的每個新值，希望它可以幫助其他人解決它們的問題，這會花費我7小時 （我不是開發人員，所以如果我製作了，請糾正我在我的解釋中有錯誤）！

Sub test() 
    Set PageObj = ActivePage 
    Set shpsObj = PageObj.Shapes 

    For Each shpObj In shpsObj 
     Dim searchWord As String 
     Dim placeHolder As Integer 
     Dim iLength As Integer 
     Dim iBeginOffset As Integer, iEndOffset As Integer 
     Set oShpChar = shpObj.Characters 

     searchWord = "&test" 
     iLength = oShpChar.CharCount 
     Do 
      iBeginOffset = InStr(oShpChar.Text, searchWord) 
      If iBeginOffset = 0 Then Exit Do ' searchWord Not found -> end the loop 

      iBeginOffset = iBeginOffset + placeHolder 
      placeHolder = iBeginOffset + Len(searchWord) - 1 
      iEndOffset = iBeginOffset + Len(searchWord) - 1 

      oShpChar.Begin = iBeginOffset 
      oShpChar.End = iEndOffset 

      If iEndOffset > iLength Then Exit Do ' Preventing the last run 
      oShpChar.CharProps(visCharacterColor) = 9 

      oShpChar.Begin = oShpChar.Begin + Len(searchWord) - 1 
      oShpChar.End = iLength 
     Loop While (iEndOffset < iLength) 
    Next 
End Sub