Sub ChangeBolds()

Dim oSld As Slide
Dim oSh As Shape
Dim x As Long

For Each oSld In ActivePresentation.Slides
For Each oSh In oSld.Shapes

If oSh.HasTextFrame Then

With oSh.TextFrame.TextRange
For x = 1 To .Runs.Count
If .Runs(x).Font.Bold Then
.Runs(x).Font.Name = "Futura Std Book"
End If
Next
End With

End If
Next
Next

End Sub