将 PPT 文件中所有形状的一种 theme/accent 颜色更改为另一种强调色

Question

我创建了此代码以将模板的一种强调色替换为另一种强调色 (ObjectThemeColors)，亮度（色调和阴影）元素被超越，旧强调色的所有阴影都被替换为相同的阴影作为给定的新颜色，有人可以在更改为新的强调色时帮助保留 brightness/shades 吗？

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

其实我觉得只保留亮度可能就够了；试一试并告诉我们。

将 PPT 文件中所有形状的一种 theme/accent 颜色更改为另一种强调色

Change one theme/accent color to another accent color for all shapes in a PPT file

powerpoint

vba