Изменить одну тему / цвет акцента на другой цвет акцента для всех фигур в файле PPT

Question

Я создал этот код для замены одного цвета акцента в шаблоне другим (ObjectThemeColors), элемент Brightness (оттенок и оттенок) переопределяется, и все оттенки старых цветов акцента заменяются тем же оттенком, что и Кто-нибудь может помочь сохранить яркость / оттенки при переходе на новые акцентные цвета?

Sub ReplaceColorNew(OldColor As String, NewColor As String)

Dim oeff As Effect
Dim i As Integer
Dim t As Integer
Dim oSld As Slide
Dim oShp As Shape
Dim x, y As Integer
Dim oPP As Placeholders

For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
    'groups
        If oShp.Type = msoGroup Then
            For x = 1 To oShp.GroupItems.Count
                With oShp.GroupItems(x)
                    If .Fill.ForeColor.ObjectThemeColor = Conversion.CLng(OldColor) + 5 Then
                       .Fill.ForeColor.ObjectThemeColor = Conversion.CLng(NewColor) + 5
                    End If

                    If .Line.Visible Then
                        If .Line.ForeColor.ObjectThemeColor = Conversion.CLng(OldColor) + 5 Then
                           .Line.ForeColor.ObjectThemeColor = Conversion.CLng(NewColor) + 5
                        End If
                    End If

                    If .HasTextFrame Then
                        If .TextFrame.HasText Then
                            For y = 1 To .TextFrame.TextRange.Runs.Count
                                If .TextFrame.TextRange.Runs(y).Font.Color.ObjectThemeColor = Conversion.CLng(OldColor) + 5 Then
                                   .TextFrame.TextRange.Runs(y).Font.Color.ObjectThemeColor = Conversion.CLng(NewColor) + 5
                                End If
                            Next
                        End If
                    End If
                End With
            Next
        Else
            With oShp 'other shapes
            ' Fill
                If .Fill.ForeColor.ObjectThemeColor = Conversion.CLng(OldColor) + 5 Then
                    .Fill.ForeColor.ObjectThemeColor = Conversion.CLng(NewColor) + 5
                End If

                ' Line
                If Not .Type = msoTable Then
                    If .Line.Visible = msoTrue Then
                        If .Line.ForeColor.ObjectThemeColor = Conversion.CLng(OldColor) + 5 Then
                            .Line.ForeColor.ObjectThemeColor = Conversion.CLng(NewColor) + 5
                        End If
                    End If
                End If

                ' Text
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        For y = 1 To .TextFrame.TextRange.Runs.Count
                            If .TextFrame.TextRange.Runs(y).Font.Color.ObjectThemeColor = Conversion.CLng(OldColor) + 5 Then
                                .TextFrame.TextRange.Runs(y).Font.Color.ObjectThemeColor = Conversion.CLng(NewColor) + 5
                            End If
                        Next
                    End If
                End If
            End With
        End If
'oShp = Nothing
    Next oShp
Next oSld


End Sub

Answer 1

Перед изменением ObjectThemeColor, выберите текущий TintAndShade и яркость, затем примените их снова после изменения ObjectThemeColor. Упрощенный пример:

With oSh.Fill.ForeColor

    lThemeColor = .ObjectThemeColor
    sBrightness = .Brightness
    sTintShade = .TintAndShade

    .ObjectThemeColor = lThemeColor + 1
    .Brightness = sBrightness
    .TintAndShade = sTintShade

End With

На самом деле, я думаю, что сохранение только Яркости может быть достаточным; попробуйте и дайте нам знать.