разделить динамические c данные с разделителями-запятыми на пары с помощью vba для использования в PowerPoint

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

, где, как Restres (j), должен иметь position1 для текста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 пробелов, после запуска кода у него был только один пробел между символом валюты и числами, и эти символы выделялись одним пробелом.

$ 500,00.255

НЕОБХОДИМО: следует выделить все существующие пробелы между символом и числом

$ 500,00.255

ваш вклад будет очень благодарен вам.