VBA + PowerPoint: перебор текста в текстовых полях, похоже, не находит текст по цвету

Мне нужно выполнить поиск и заменить определенные цвета на слайдах PowerPoint. Долгая история, и мне не разрешено менять цветовые схемы шаблона.

Я нашел этот скрипт VBA http://skp.mvps.org/pptxp006.htm, и он работает отлично подходит для линий / заполнения графики PPT. Но, похоже, он не обрабатывает текст должным образом.

Общий подход этого сценария VBA:

For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
        If oShp.Type = msoGroup Then
        For I = 1 To oShp.GroupItems.Count
                [[ do something to oShp.GroupItems(i) ]]
            Next I
        Else
            [[ do something to oShp ]]        
    End If
    Next oShp
Next oSld

а «сделать что-нибудь» включает вызов FindAndReColourText():

Function FindAndReColourText(oShp As Shape, _
    oRGB As Long, oNewRGB As Long)
Dim I As Integer
Dim oTxtRng As TextRange
On Error Resume Next
If oShp.HasTextFrame Then
    If oShp.TextFrame.HasText Then
        Set oTxtRng = oShp.TextFrame.TextRange            
        For I = 1 To oTxtRng.Runs.Count
            With oTxtRng.Runs(I).Font.Color                    
                If .Type = msoColorTypeRGB Then                       
                    If .rgb = oRGB Then
                        .rgb = oNewRGB
                    End If
                End If
            End With
        Next I
    End If
End If
End Function

Я проверил, и кажется, что текст повторяется, но он каким-то образом не соответствует цвету. Любые предложения о том, как я должен отлаживать?

(Я действительно не знаю, где искать, чтобы узнать это, и кто-то быстро свалил мне эту задачу с десятками слайдов, которые мне нужно изменить.)


person Jason S    schedule 10.06.2014    source источник


Ответы (1)


Ага, проблема была в том, что он не работал с текстом, использующим цвета шаблона; тест .Type = msoColorTypeRGB не совпал.

If .Type = msoColorTypeRGB Then                       
   If .rgb = oRGB Then
         .rgb = oNewRGB
   End If
End If

Я удалил этот внешний If, и он работал правильно.

person Jason S    schedule 10.06.2014