Discussion :

[Uranne-jimmy]

Bonjour,
Le sujet des charttitles en vba excel est visiblement source de beaucoup de question. J'apporte la mienne, en espérant recevoir une réponse.
J'ai décidé pour avancé mes collègues de créer un bouton rechercher/remplacer, mais dans les titres de graphique, seul élément que nous ne lions pas à une cellule (ce serait une idée, mais bon, un peu sale quand même).

Mon soucis :
la procédure marche ! (c'est pas un soucis ça) mais ne garde pas les fonts, y compris l'italique, chose importante car imposé par une nomenclature précise.
Vlà la procédure toute conne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
    For Each char In ActiveSheet.ChartObjects
        If char.Chart.HasTitle Then
            char.Chart.ChartTitle.Text
            char.Chart.ChartTitle.Text = Replace(char.Chart.ChartTitle.Text, TextBox1.Text, TextBox2.Text)
        End If
    Next
End Sub

trololo

Mon idée serait de détecter les mises en forme, de garder strings affecté dans une collection puis une fois la modification effectuer, remettre tout comme avant. J'allais m'y mettre quand j'ai compris le point de blocage : comment trouver les chaines de caractère qui ont une mise en forme ?

[Mr Poulpe]

Bonjour,

Essaie peut être ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub CommandButton1_Click()
    For Each char In ActiveSheet.ChartObjects
        If char.Chart.HasTitle Then
            char.Chart.ChartTitle.Text
            char.Chart.ChartTitle.characters.Text = Replace(char.Chart.ChartTitle.Text, TextBox1.Text, TextBox2.Text)
        End If
    Next
End Sub

Poulpe

[Uranne-jimmy]

Ca ne fonctionne pas j'aurais bien aimé j'avoue.

J'ai également essayé ça du coup :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
    For Each char In ActiveSheet.ChartObjects
        If char.Chart.HasTitle Then
            char.Chart.ChartTitle.Text
            char.Chart.ChartTitle.characters.Text = Replace(char.Chart.ChartTitle.characters.Text, TextBox1.Text, TextBox2.Text)
        End If
    Next
End Sub

Sans plus de succès.

[Mr Poulpe]

Peut être ça sinon :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
    For Each char In ActiveSheet.ChartObjects
        If char.Chart.HasTitle Then
            char.Chart.ChartTitle.Text
            char.Chart.ChartTitle.Characters(1, Len(char.Chart.ChartTitle.Text)).Text = Replace(char.Chart.ChartTitle.Text, TextBox1.Text, TextBox2.Text)
        End If
    Next
End Sub

Poulpe

[Docmarti]

Bonjour

Peut-être ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub CommandButton1_Click()
 
    For Each char In ActiveSheet.ChartObjects
        If char.Chart.HasTitle Then
 
            char.Chart.ChartArea.AutoScaleFont = False
            char.Chart.ChartTitle.Text = Replace(char.Chart.ChartTitle.Text, TextBox1, TextBox2)
        End If
    Next
End Sub

[Uranne-jimmy]

Aucune des deux méthodes dernièrement proposé ne fonctionne :/
Le format string bloc, il ne permet pas de garder en mémoire les styles des textes, sauf si il existe un type de chaine de caractère qui prenne en compte ce détail, il va me falloir remettre les styles une fois le changement effectué.

C'est moche mais j'ai un début de réponse.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub trouverItalique()
    For Each g In ActiveSheet.ChartObjects
        Dim phrase As String
        For i = 0 To Len(g.Chart.ChartTitle.Text)
            If InStr(g.Chart.ChartTitle.Characters(i, 1).Font.FontStyle, "Italic") > 0 Then
                phrase = phrase & g.Chart.ChartTitle.Characters(i, 1).Text
            End If
        Next
        MsgBox (phrase)
    Next
End Sub

[Uranne-jimmy]

C'est toujours aussi foireux, mais ça marche, alors partageons le foireux avec nos pairs !
En utilisant la procédure du dernier post légèrement modifié (vous comprendrez en quoi) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click()
Dim char As ChartObject
    For Each char In ActiveSheet.ChartObjects
        If char.Chart.HasTitle Then
            Dim phrase As String
            phrase = trouverItalique(char)
            char.Chart.ChartArea.AutoScaleFont = False
            char.Chart.ChartTitle.Characters.Text = Replace(char.Chart.ChartTitle.Characters.Text, TextBox1.Text, TextBox2.Text)
            Dim index As Integer
            index = InStr(char.Chart.ChartTitle.Characters.Text, phrase)
            char.Chart.ChartTitle.Characters(index, Len(phrase)).Font.Italic = True
        End If
    Next
End Sub