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:
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 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…