如何更改形状文本框中特定文本的字体颜色? VBA
How to i change the font color of specific text in a shape textframe? VBA
我正在尝试更改形状文本框中特定文本的字体颜色(文本在同一框中多次出现)。这是我目前拥有的。
这就是我想要实现的目标。
基本上是找到单词“Capital:”并选择它直到下一个 space 并将其更改为红色。 (例如:Capital:Boston、Capital:Neveda、Capital:NewJersey)。
我已有的代码是这样的。
With OrgChart
With .Shapes("ChartItem" & OrgID).GroupItems("OrgTitle")
.TextFrame2.TextRange.Characters(1, 2).Font.Fill.ForeColor.RGB = RGB(255, 0, 255)
End With
End With
我需要有关 Character(x,x) 功能的帮助 - 也许是 InStr 函数...不确定它是如何工作的。
RegEx
是在 PC 上进行模式匹配的绝佳选择。
Sub TestRegX()
Const Pattern As String = "Capital:*([^\s]+)"
Dim Shape As Shape
Set Shape = ActiveSheet.Shapes(1)
HighLightTextFrame2Matches Shape.TextFrame2, Pattern, RGB(255, 0, 255)
End Sub
Sub HighLightTextFrame2Matches(TextFrame2 As TextFrame2, Pattern As String, RGB As Long)
Dim RegX As Object
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.MultiLine = True
.Pattern = Pattern
End With
With TextFrame2.TextRange
If RegX.Test(.Text) Then
Dim Match As Match
For Each Match In RegX.Execute(.Text)
.Characters(Match.FirstIndex + 1, Match.Length).Font.Fill.ForeColor.RGB = RGB
Next
End If
End With
End Sub
InStr
将适用于 MAC 和 PC。
Sub TestHighLightTextFrameSplit()
Const Match As String = "Capital:"
Dim Shape As Shape
Set Shape = ActiveSheet.Shapes(1)
HighLightTextFrameMatch Shape.TextFrame2, Match, RGB(255, 0, 255)
End Sub
Sub HighLightTextFrameMatch(TextFrame2 As TextFrame2, Match As String, RGB As Long)
Dim FirstIndex As Long, LastIndex As Long, Length As Long
FirstIndex = 1
With TextFrame2.TextRange
While InStr(FirstIndex, .Text, Match) > 0
FirstIndex = InStr(FirstIndex, .Text, Match)
LastIndex = InStr(FirstIndex, .Text, " ")
Length = LastIndex - FirstIndex
.Characters(FirstIndex, Length).Font.Fill.ForeColor.RGB = RGB
FirstIndex = FirstIndex + 1
Wend
End With
End Sub
我正在尝试更改形状文本框中特定文本的字体颜色(文本在同一框中多次出现)。这是我目前拥有的。
这就是我想要实现的目标。
基本上是找到单词“Capital:”并选择它直到下一个 space 并将其更改为红色。 (例如:Capital:Boston、Capital:Neveda、Capital:NewJersey)。
我已有的代码是这样的。
With OrgChart
With .Shapes("ChartItem" & OrgID).GroupItems("OrgTitle")
.TextFrame2.TextRange.Characters(1, 2).Font.Fill.ForeColor.RGB = RGB(255, 0, 255)
End With
End With
我需要有关 Character(x,x) 功能的帮助 - 也许是 InStr 函数...不确定它是如何工作的。
RegEx
是在 PC 上进行模式匹配的绝佳选择。
Sub TestRegX()
Const Pattern As String = "Capital:*([^\s]+)"
Dim Shape As Shape
Set Shape = ActiveSheet.Shapes(1)
HighLightTextFrame2Matches Shape.TextFrame2, Pattern, RGB(255, 0, 255)
End Sub
Sub HighLightTextFrame2Matches(TextFrame2 As TextFrame2, Pattern As String, RGB As Long)
Dim RegX As Object
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.MultiLine = True
.Pattern = Pattern
End With
With TextFrame2.TextRange
If RegX.Test(.Text) Then
Dim Match As Match
For Each Match In RegX.Execute(.Text)
.Characters(Match.FirstIndex + 1, Match.Length).Font.Fill.ForeColor.RGB = RGB
Next
End If
End With
End Sub
InStr
将适用于 MAC 和 PC。
Sub TestHighLightTextFrameSplit()
Const Match As String = "Capital:"
Dim Shape As Shape
Set Shape = ActiveSheet.Shapes(1)
HighLightTextFrameMatch Shape.TextFrame2, Match, RGB(255, 0, 255)
End Sub
Sub HighLightTextFrameMatch(TextFrame2 As TextFrame2, Match As String, RGB As Long)
Dim FirstIndex As Long, LastIndex As Long, Length As Long
FirstIndex = 1
With TextFrame2.TextRange
While InStr(FirstIndex, .Text, Match) > 0
FirstIndex = InStr(FirstIndex, .Text, Match)
LastIndex = InStr(FirstIndex, .Text, " ")
Length = LastIndex - FirstIndex
.Characters(FirstIndex, Length).Font.Fill.ForeColor.RGB = RGB
FirstIndex = FirstIndex + 1
Wend
End With
End Sub