сохранить формат при использовании регулярного выражения заменить в PowerPoint VBA - PullRequest
0 голосов
/ 19 июня 2020
Private Sub replaceCurrency()
Dim sld As Slide
Dim oSh As Shape
Dim last, start, i, X As Long
Dim trFoundText As TextRange, shpText As TextRange
Dim allMatches As Object, match As Object, RE As Object

Set sld = Application.ActiveWindow.View.Slide
Set RE = CreateObject("vbscript.regexp")

On Error GoTo Replace_in_Shapes_Error

With RE
    .Global = True
    .Multiline = False
    .ignorecase = True
    .Pattern = "([$€£¥])([ ])+(?=\d)" 'Checks for currencies with one or more following space(s)
End With

For Each oSh In sld.Shapes
    With oSh
    
        If .HasTextFrame Then
            Set shpText = oSh.TextFrame.TextRange
            Set allMatches = RE.Execute(shpText)
            For Each match In allMatches
                Debug.Print "txtfr:  " & match.submatches(0)
                Debug.Print "txtfr:  " & match.firstindex
                Set trFoundText = oSh.TextFrame.TextRange.Find(match.submatches(0))
                If Not (trFoundText Is Nothing) Then
                    start = match.firstindex
                    last = oSh.TextFrame.TextRange.Find(match.submatches(0)).Characters.Length
                    oSh.TextFrame.TextRange.Characters(start, last + 3).Select
                    HighlightWithBoxBorder
                End If
            Next
            
        ElseIf .Type = msoGroup Then

          For X = 1 To .GroupItems.Count
                If .GroupItems(X).HasTextFrame Then
                    If .GroupItems(X).TextFrame.HasText Then
                        Set shpText = .GroupItems(X).TextFrame.TextRange
                        Set allMatches = RE.Execute(shpText)
                        For Each match In allMatches
                            Debug.Print "txtfr+Grup:  " & match.submatches(0)
                            Debug.Print "txtfr+Grup:  " & match.firstindex
                            For i = 0 To (match.submatches.Count) - 1
                                Set trFoundText = oSh.TextFrame.TextRange.Find(match.submatches(i))
                                If Not (trFoundText Is Nothing) Then
                                    start = match.firstindex
                                    last = oSh.TextFrame.TextRange.Find(match.submatches(0)).Characters.Length
                                    oSh.TextFrame.TextRange.Characters(start, last + 3).Select
                                    HighlightWithBoxBorder
                                End If
                            Next i
                        Next match
                    End If
                End If
          Next X
        End If
    End With
Next oSh

Без потерь при форматировании при выполнении. Все хорошо. но за исключением выполнения сгруппированных элементов в строке кода ---> Set trFoundText = o Sh .TextFrame.TextRange.Find (match.submatches (i)) ---> пропустил его выполнение.

Нужна помощь, чтобы получить значение в приведенной выше строке кода для сгруппированных элементов

1 Ответ

0 голосов
/ 02 июля 2020
Set trFoundText = .GroupItems(X).TextFrame.TextRange.Find(match.submatches(i))
If Not (trFoundText Is Nothing) Then
  start = match.firstindex
  last = .GroupItems(X).TextFrame.TextRange.Find(match.submatches(i)).Characters.Length
  .GroupItems(X).TextFrame.TextRange.Characters(start, last + 3).Select
  HighlightWithBoxBorder
End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...