使用powerpoint中使用的vba将动态逗号交付的数据拆分成对

Question

只需要用黄色突出显示PPT中所有幻灯片的文本范围。在逗号分隔的变量中获得可高亮显示的文本和起始位置。从该变量中，需要将其拆分成对，以帮助进一步编码用黄色突出显示。

示例变量RetRes可能具有£、130、€、63、$、16，从这个需求中，RetRes应该变成[(130英镑((63欧元((16美元(]

[(文本1，位置1((文本2，位置2((文本3，位置3(]

substr = Split(RetRes, ",")
For i = LBound(substr) To UBound(substr)
substr(i) = Trim(substr(i))
msgbox " SubStr: " & substr(i)
Next i

通过以上代码无法按预期使用。请帮助使用以下中的配对

shp6.TextFrame.TextRange.Characters(Restres(j), len(Restres)).select

其中as Restres(j(应具有文本1的位置1。

Answer 1

Function RegExSample(testString As String, oSource As TextRange)
Dim oReg2 As VBScript_RegExp_55.RegExp           
Set oReg2 = New VBScript_RegExp_55.RegExp
With oReg2
.Global = True
.Multiline = False
.ignorecase = True
.pattern = "([$€£])([ ])+(?=d)" 'Checks for currencies with one or more following space(s)
End With

If oReg2.test(testString) Then oSource.text = oReg2.Replace(testString, "<name>$1$2</name>")
End Function
Sub makeHighlight()
'checks for the tags. When it finds them, it highlighted
'or italics the text.
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim openTag As TextRange
Dim closeTag As TextRange
Dim endRange As Long
Dim startRange As Long

For Each oSld In ActivePresentation.Slides
ActiveWindow.View.GotoSlide Index:=oSld.SlideIndex
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
Set openTag = oTxtRng.Find(findwhat:="<name>", _
MatchCase:=False)
Do While Not (openTag Is Nothing)
Set closeTag = oTxtRng.Find(findwhat:="</name>", _
MatchCase:=False)
If closeTag Is Nothing Then
endRange = oTxtRng.Length
Else
endRange = closeTag.Start - 1
oTxtRng.Characters(closeTag.Start, _
closeTag.Length).Delete
End If
startRange = openTag.Start

oTxtRng.Characters(startRange, _
endRange - startRange + 1) _
.Select
ActiveWindow.Selection.TextRange2.Font.Highlight.RGB = RGB(255, 255, 175)

oTxtRng.Characters(openTag.Start, _
openTag.Length).Delete
Set openTag = oTxtRng.Find(findwhat:="<name>", _
MatchCase:=False)
Loop

End If
Next oShp
Next oSld
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
Set openTag = oTxtRng.Find(findwhat:="<name>", _
MatchCase:=False)
Do While Not (openTag Is Nothing)
Set closeTag = oTxtRng.Find(findwhat:="</name>", _
MatchCase:=False)
If closeTag Is Nothing Then
endRange = oTxtRng.Length
Else
endRange = closeTag.Start - 1
oTxtRng.Characters(closeTag.Start, _
closeTag.Length).Delete
End If
startRange = openTag.Start
oTxtRng.Characters(startRange, _
endRange - startRange + 1) _
.Font.Italic = True
oTxtRng.Characters(openTag.Start, _
openTag.Length).Delete
Set openTag = oTxtRng.Find(findwhat:="<name>", _
MatchCase:=False)
Loop

End If
Next oShp
Next oSld
End Sub
Sub HighlightCurrencieswithSpaces()
Dim sld As Slide
Dim shp2 As Shape
Dim shpText2 As TextRange
For Each sld In ActivePresentation.Slides
For Each shp2 In sld.Shapes
If shp2.HasTextFrame Then
Set shpText2 = shp2.TextFrame.TextRange
RegExSample shpText2.text, shpText2
End If
Next shp2
Next sld
Call makeHighlight
End Sub

虽然我有上面编译的解决方案，但有一个小问题如下货币之间的间隔并没有保持原样；例如，如果货币符号和数字之间有5个空格，运行代码后，货币符号和数据之间只有一个空格，并用一个空格突出显示这些符号。

$50000.255

需要：应突出显示符号和数字之间的所有现有空格

$50000.255

感谢您的贡献。