Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
440 views
in Technique[技术] by (71.8m points)

powerpoint - PPT VBA: Change a shape's accent color from one theme color to another

In PPT VBA, I'm trying to change all shapes in a file that are in one accent color to another. I supply the values from this form to my function, but its not accepting the OldColor and NewColor (themecolors) as msoThemeColorAccent1 but only takes as 15 instead. but it is accepting when I give msoThemeColorAccent1 for Fill.ForeColor.ObjectThemeColor; just not accepting when supplied from the function arguments. can anybody please suggest a solution?

this is my form: Form

these are my code blocks:

Private Sub cmdApply_Click()
    ReplaceColors cboOldColor.Value, cboNewColor.Value, cboOldTint.Text, cboNewTint.Text
End Sub

Sub ReplaceColors(OldColor As Variant, NewColor As Variant, OldTint As String, NewTint As String)

Dim i As Integer
Dim t As Integer
Dim oSld As Slide
Dim oShp As Shape
Dim x, y As Integer
Dim sBrightness
Dim oColor, nColor As ThemeColor
Dim oPP As Placeholders

    For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
        'groups
          If oShp.Type = msoGroup Then
            'not groups
            Else
            With oShp 'other shapes
                ' Fill
                If .Fill.ForeColor.ObjectThemeColor = OldColor And .Fill.ForeColor.Brightness = OldTint Then
                        .Fill.ForeColor.ObjectThemeColor = NewColor
                        .Fill.BackColor.Brightness = NewTint
                End If

                ' Line
                If Not .Type = msoTable Then
                    If .Line.Visible = msoTrue Then
                        If .Line.ForeColor.ObjectThemeColor = OldColor And .Line.ForeColor.Brightness = OldTint Then
                            .Line.ForeColor.ObjectThemeColor = NewColor
                            .Line.ForeColor.Brightness = NewTint
                        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 = OldColor And .TextFrame.TextRange.Runs(y).Font.Color.Brightness = OldTint Then
                                .TextFrame.TextRange.Runs(y).Font.Color.ObjectThemeColor = NewColor
                                .TextFrame.TextRange.Runs(y).Font.Color.Brightness = NewTint
                            End If
                        Next
                    End If
                End If
            End With
            End If
    'oShp = Nothing
        Next oShp
    Next oSld
End Sub
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)
Waitting for answers

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...