Sub RenommerTexteBoutonClasseur()
Dim w As Worksheet, o As Shape, farfelu, t, a&, b&, c&
farfelu = InputBox("Saisir des choses farfelues" & Chr(13) & "(séparée par un /)", "Intitulés", "abcdef/toto123/Staple1600")
t = Split(farfelu, "/")
a = Len(t(0)): b = Len(t(1)): c = Len(t(2)) + 1
For Each w In Worksheets
For Each o In w.Shapes
If InStr(1, o.TextFrame.Characters.Text, "Onglets") > 0 Then
With o.TextFrame
.Characters.Text = ""
.Characters.Font.ColorIndex = 0
.Characters.Text = t(0) & Chr(10) & t(1) & Chr(10) & t(2)
.Characters(1, a).Font.ColorIndex = 3
.Characters(1, a).Font.Size = 18
.Characters(a + 2, b).Font.ColorIndex = 5
.Characters(a + 2, b).Font.Size = 16
.Characters(a + b + 2, c).Font.ColorIndex = 3
.Characters(a + b + 2, c).Font.Size = 16
End With
End If
Next o
Next w
Erase t
End Sub