Macro - Rechercher et mettre en gras

Flow · 5 Novembre 2012

Bonjour à tous,

J'ai un tableau contenant du texte, et je souhaiterai rechercher un mot (ici, le mot "test") et le mettre en gras dans ton mon tableau.
Exemple :

Colonne1 Colonne2
1 test de test
2 de test de
3 de test
4 test de
5 test
6 pas le mot recherché

et après exécution de la macro je souhaiterai :

Colonne1 Colonne2
1 test de test
2 de test de
3 de test
4 test de
5 test
6 pas le mot recherché

J'ai commencé ma macro comme ceci :

Code:

Sub Search&Bold()

Do
    If Cells.Find(What:="test") Is Nothing Then
       Exit Do
    Else
       Cells.Find(What:="test").Activate
       <mettre en gras>
    End If
Loop

End Sub

En essayant de lui intégrer quelque chose comme ceci :

Code:

    ActiveCell.FormulaR1C1 = "de test de"
    With ActiveCell.Characters(Start:=1, Length:=3).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=4, Length:=4).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=8, Length:=3).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With

Mais sans réussite.

Une idée pour m'aider ?

Merci par avance

DoubleZero · 5 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonjour, Flow, le Forum,

Un code adaptable ici.

A bientôt

phlaurent55 · 5 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonjour à tous,

un essai en pièce jointe

à+
Philippe

BOISGONTIER · 5 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonsoir,

Voir PJ

Code:

  mot = "test"
  For Each c In Range("A2:A" & [A65000].End(xlUp).Row)
   p = InStr(UCase(c), UCase(mot))
   If p > 0 Then c.Characters(Start:=p, Length:=Len(mot)).Font.Bold = True
  Next c

Pour ne pas mettre en gras testament

Code:

  mot = "test"
  mot2 = mot & " "
  For Each c In Range("A2:A" & [A65000].End(xlUp).Row)
   p = InStr(UCase(c & " "), UCase(mot2))
   If p > 0 Then c.Characters(Start:=p, Length:=Len(mot)).Font.Bold = True
  Next c

Pour plusieurs occurences de test

Code:

Sub essai2()
  mot = "test"
  mot2 = mot & " "
  For Each c In Range("A2:A" & [A65000].End(xlUp).Row)
     début = 1
     p = InStr(début, UCase(c & " "), UCase(mot2))
     Do While p > 0
        c.Characters(Start:=p, Length:=Len(mot)).Font.Bold = True
        début = p + Len(mot2) + 1
        p = InStr(début, UCase(c & " "), UCase(mot2))
     Loop
  Next c
End Sub

JB

david84 · 5 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonsoir,
via l'utilisation d'une expression rationnelle, code à tester (données à tester en colonnes A) :

Code:

Sub test()
mot = Trim(InputBox("Entrez le mot à mettre en gras"))
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Global = True
.ignorecase = True
.Pattern = "\b" & mot & "\b"
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        chaine = Cells(i, 1).Value
        If .test(chaine) = True Then
            Set matches = .Execute(chaine)
            For j = 0 To matches.Count - 1
                Cells(i, 1).Characters(Start:=matches.Item(j).firstIndex + 1, _
                Length:=matches.Item(j).Length).Font.FontStyle = "Gras"
            Next j
        End If
    Next i
    End With
End Sub

Fait notamment la différence entre test et testament.
A+

david84 · 6 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonjour,
le motif utilisé prenait en compte "testé" (bizarre d'ailleurs...). J'ai donc modifié le code comme suit :

Code:

Sub test()
mot = Trim(InputBox("Entrez le mot à mettre en gras"))
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Global = True
.ignorecase = True
.Pattern = "(\s|^)" & mot & "(\s|$)"
    For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        chaine = c.Value
        If .test(chaine) = True Then
            Set matches = .Execute(chaine)
            For Each Match In matches
                c.Characters(Start:=Match.firstIndex + 1, _
                Length:=Match.Length).Font.Bold = True
            Next Match
        End If
    Next c
    End With
End Sub

La phrase suivante

j'ai testé ceci : test est dans testament mais testament n'est pas dans test

ramène

j'ai testé ceci : test est dans testament mais testament n'est pas dans test

A+

Flow · 6 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Merci à tous.
J'ai testé la solution de david (désolé, et encore merci pour les autres) qui semble correctement fonctionner.
Par contre, j'ai modifié le code pour que je puisse utiliser le "remplacer" à la place du "rechercher".

Cela fonctionne correctement, sauf pour le cas du mot "testé". Lorsque je remplace "test" par "titi", cela me donne "titié". Logique vous allez me dire.

J'ai essayé de réutiliser ce bout de code, bien que je ne sache pas exactement comment il fonctionne :

Code:

        .Global = True
        .ignorecase = True
        .Pattern = "(\s|^)" & mot & "(\s|$)"

Auriez-vous une idée pour que mon "remplacer" remplace uniquement le motif (comme précédemment pour le "rechercher") ?

Voici mon code actuel, fonctionnant, mais avec l'erreur notée ci-dessus :

Code:

Sub test()

motAremplacer = Trim(InputBox("Entrer le mot à remplacer"))
mot = Trim(InputBox("Entrer le mot de remplacement"))
  Dim RepQuestion As String
  Dim Question As String

Cells.Replace What:=motAremplacer, Replacement:=mot, LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
              
        
Question = "Voulez-vous mettre en gras ?"
RepQuestion = MsgBox(Question, vbQuestion + vbYesNo, "Bold")

    If RepQuestion = vbNo Then
        MsgBox ("mot remplacé et non mis en gras")
    Else
        Set oRegExp = CreateObject("vbscript.regexp")
        With oRegExp
        .Global = True
        .ignorecase = True
        .Pattern = "(\s|^)" & mot & "(\s|$)"
         For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
                chaine = c.Value
                If .test(chaine) = True Then
                    Set matches = .Execute(chaine)
                    For i = 0 To matches.Count - 1
                     c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                     Length:=matches.Item(i).Length).Font.Bold = True
                  Next i
                End If
         Next c
         End With
     End If
     
End Sub

Merci par avance

JNP · 6 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonjour

,
Quitte à utiliser du RegExp, autant le faire jusqu'au bout

:

Code:

Sub test()
    motaremplacer = Trim(InputBox("Entrer le mot à remplacer"))
    mot = Trim(InputBox("Entrer le mot de remplacement"))
        Dim RepQuestion As String
        Dim Question As String
    Question = "Voulez-vous mettre en gras ?"
    RepQuestion = MsgBox(Question, vbQuestion + vbYesNo, "Bold")
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
        .Global = True
        .ignorecase = True
        For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
            .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
            chaine = c.Value
            If .test(chaine) = True Then
                c.Value = .Replace(chaine, "$1" & mot & "$3")
                chaine = c.Value
                .Pattern = "(\s|^)" & mot & "(\s|$)"
                If RepQuestion = vbYes Then
                    Set matches = .Execute(chaine)
                    For i = 0 To matches.Count - 1
                        c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                        Length:=matches.Item(i).Length).Font.Bold = True
                    Next i
                End If
            End If
        Next c
    End With
End Sub

Bonne suite

Flow · 6 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Merci beaucoup JNP.

Je ne suis pas expert VBA (je ne "code" que pour mes quelques besoins), et ne connaissait pas "RegExp".

Dernier point, après j'arrête de vous ennuyer :
Lorsque le mot que je cherche à remplacer est déjà en gras, et que je le remplace par un autre mot, tout le contenu de la cellule est mis en gras.

Exemple :

test
testé
dernier test

J'applique ma macro, en demandant de remplacer "test" par "titi", cela me donne :

titi
testé
dernier titi

alors que je souhaiterai :

titi
testé
dernier titi

De la même façon, lorsque je veux remplacer un mot en gras, par un autre mot non-gras, le mot est bien remplacé, mais toutes les cellules qui contenaient un mot en gras auparavant ont tout leur contenu en gras.

En résumé :

- comment éviter que toute la cellule soit en gras ?
- comment remplacer un mot en gras par un mot non-gras ?

Voici le code entier (désolé pour la longueur, comme je vous l'ai dit, je ne suis pas dév' ! seule la 1ere partie du 2ème encadré vous intéressera) :

Code:

' ---
' TEST DE L'EXISTENCE D'UNE FEUILLE EXCEL
' ---



Function FeuilleExiste(MaFeuille As String) As Boolean

    Dim Feuille As Worksheet
    
    FeuilleExiste = False
    For Each Feuille In Worksheets
        If (Feuille.Name = MaFeuille) Then
            FeuilleExiste = True
        End If
    Next Feuille
    
End Function

Code:

Sub test2()
   
motaremplacer = Trim(InputBox("Entrer le mot à remplacer"))
mot = Trim(InputBox("Entrer le mot de remplacement"))

  Dim RepQuestionGras As String
  Dim QuestionGras As String
QuestionGras = "Voulez-vous mettre en gras ?"
RepQuestionGras = MsgBox(QuestionGras, vbQuestion + vbYesNo, "Bold")

  Dim RepQuestionToutesFeuilles As String
  Dim QuestionToutesFeuilles As String
QuestionToutesFeuilles = "Voulez-vous excuter la macro sur toutes les feuilles ?"
RepQuestionToutesFeuilles = MsgBox(QuestionToutesFeuilles, vbQuestion + vbYesNo, "Toutes les feuilles ?")

If RepQuestionToutesFeuilles = vbYes Then
  
    Dim Ws As Worksheet
    
    For Each Ws In Worksheets
        Ws.Select
            
        If RepQuestionGras = vbNo Then
            Set oRegExp = CreateObject("vbscript.regexp")
            With oRegExp
                .Global = True
                .ignorecase = True
                For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
                    .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
                    chaine = c.Value
                    If .test(chaine) = True Then
                        c.Value = .Replace(chaine, "$1" & mot & "$3")
                        chaine = c.Value
                        .Pattern = "(\s|^)" & mot & "(\s|$)"
                        If RepQuestionGras = vbYes Then
                            Set matches = .Execute(chaine)
                            For i = 0 To matches.Count - 1
                                c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                                Length:=matches.Item(i).Length).Font.Bold = False
                            Next i
                        End If
                    End If
                Next c
            End With
        Else
            Set oRegExp = CreateObject("vbscript.regexp")
            With oRegExp
                .Global = True
                .ignorecase = True
                For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
                    .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
                    chaine = c.Value
                    If .test(chaine) = True Then
                        c.Value = .Replace(chaine, "$1" & mot & "$3")
                        chaine = c.Value
                        .Pattern = "(\s|^)" & mot & "(\s|$)"
                        If RepQuestionGras = vbYes Then
                            Set matches = .Execute(chaine)
                            For i = 0 To matches.Count - 1
                                c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                                Length:=matches.Item(i).Length).Font.Bold = True
                            Next i
                        End If
                    End If
                Next c
            End With

         End If
    Next Ws
    MsgBox (Chr(34) & motaremplacer & Chr(34) & " a été remplacé et non mis en gras par " & Chr(34) & mot & Chr(34) & " sur toutes les feuilles")
Else

    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook

Do
    For k = 0 To 9
    Dim QuestionNomFeuille As String
    QuestionNomFeuille = Trim(InputBox("Saisir le nom de la feuille sur laquelle vous voulez exécuter la macro ?"))
        
        If FeuilleExiste(QuestionNomFeuille) Then
            
            Sheets(QuestionNomFeuille).Select
            
            Dim RepQuestion4 As String
            Dim Question4 As String
  
            Question4 = "Valider ?"
            RepQuestion4 = MsgBox(Question4, vbQuestion + vbYesNo, "Validation")
            
            If RepQuestion4 = vbYes Then
            
            Sheets(QuestionNomFeuille).Activate
                         
               If RepQuestion = vbNo Then
                    MsgBox (Chr(34) & motaremplacer & Chr(34) & " a été remplacé et non mis en gras par " & Chr(34) & mot & Chr(34) & " sur la feuille " & Chr(34) & QuestionNomFeuille & Chr(34))
                Else
                    Set oRegExp = CreateObject("vbscript.regexp")
                    With oRegExp
                        .Global = True
                        .ignorecase = True
                        For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
                            .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
                            chaine = c.Value
                            If .test(chaine) = True Then
                                c.Value = .Replace(chaine, "$1" & mot & "$3")
                                chaine = c.Value
                                .Pattern = "(\s|^)" & mot & "(\s|$)"
                                If RepQuestionGras = vbYes Then
                                    Set matches = .Execute(chaine)
                                    For i = 0 To matches.Count - 1
                                        c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                                        Length:=matches.Item(i).Length).Font.Bold = True
                                    Next i
                                End If
                            End If
                        Next c
                    End With
                 End If
        k = 9
            
            Else
                
               k = 0
            
            End If
          
        Else
            MsgBox (Chr(34) & QuestionNomFeuille & Chr(34) & " n'existe pas"), vbExclamation
            If k = 9 Then
            MsgBox ("Feuille non-trouvée après 10 tentatives. Macro annulée")
            End If
            
        End If
        
    Next
    
Loop While k = 9

End If

End Sub

Merci par avance

Flow · 6 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Petite mise à jour de mon test pour plus de détail : visiblement

texte original :

test
testé
testament
un test
test un
testa

Après application de la macro (remplacer "test" par "XXX") :

XXX => OK
testé => OK
testament => OK
un XXX => OK
XXX un => KO
testa => OK

david84 · 6 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Bonsoir,
je n'ai pas tout compris mais peut-être comme cela en partant du code de Jean-Noël :

Code:

Sub test()
    motaremplacer = Trim(InputBox("Entrer le mot à remplacer"))
    mot = Trim(InputBox("Entrer le mot de remplacement"))
        Dim RepQuestion As String
        Dim Question As String
    Question = "Voulez-vous mettre en gras ?"
    RepQuestion = MsgBox(Question, vbQuestion + vbYesNo, "Bold")
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
        .Global = True
        .ignorecase = True
        For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
            .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
            c.Font.Bold = False
            chaine = c.Value
            If .test(chaine) = True Then
                Set matches = .Execute(chaine)
                c.Value = .Replace(chaine, "$1" & mot & "$3")
                chaine = c.Value
                .Pattern = "(\s|^)" & mot & "(\s|$)"
                If RepQuestion = vbYes Then
                    Set matches = .Execute(chaine)
                    For i = 0 To matches.Count - 1
                        c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                        Length:=matches.Item(i).Length).Font.Bold = True
                    Next i
                End If
            End If
        Next c
    End With
End Sub

A+

Ceci-dit, si tu as du mal avec les RegExp, pourquoi ne pas adapter la proposition de Jacques qui est efficace et qui serait peut-être plus simple pour toi (attention cependant avec alcootest par exemple).
A+

Flow · 7 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Merci David, nickel !

Flow · 7 Novembre 2012

Re : Macro - Rechercher et mettre en gras

Voici la macro mise à jour, simplifiée et surtout, mise au propre :

Code:

Sub ReplaceAndBold()

  Dim RepQuestionToutesFeuilles As String
  Dim QuestionToutesFeuilles As String
QuestionToutesFeuilles = "Voulez-vous excuter la macro sur toutes les feuilles ?"
RepQuestionToutesFeuilles = MsgBox(QuestionToutesFeuilles, vbQuestion + vbYesNo, "Toutes les feuilles ?")

If RepQuestionToutesFeuilles = vbYes Then

    Dim Ws As Worksheet
    
    motaremplacer = Trim(InputBox("Entrer le mot à remplacer"))
    mot = Trim(InputBox("Entrer le mot de remplacement"))
    Dim RepQuestionGras As String
    Dim QuestionGras As String
    QuestionGras = "Voulez-vous mettre en gras ?"
    RepQuestionGras = MsgBox(QuestionGras, vbQuestion + vbYesNo, "Bold")
    
    For Each Ws In Worksheets
        Ws.Select

                                    Set oRegExp = CreateObject("vbscript.regexp")
                                    With oRegExp
                                        .Global = True
                                        .ignorecase = False
                                        For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
                                            .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
                                            c.Font.Bold = False
                                            chaine = c.Value
                                            If .test(chaine) = True Then
                                                Set matches = .Execute(chaine)
                                                c.Value = .Replace(chaine, "$1" & mot & "$3")
                                                chaine = c.Value
                                                .Pattern = "(\s|^)" & mot & "(\s|$)"
                                                If RepQuestionGras = vbYes Then
                                                    Set matches = .Execute(chaine)
                                                    For i = 0 To matches.Count - 1
                                                        c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                                                        Length:=matches.Item(i).Length).Font.Bold = True
                                                    Next i
                                                End If
                                            End If
                                        Next c
                                    End With

    Next Ws
    If RepQuestionGras = vbNo Then
    MsgBox (Chr(34) & motaremplacer & Chr(34) & " a été remplacé par " & Chr(34) & mot & Chr(34) & " sur toutes les feuilles"), vbInformation
    Else
    MsgBox (Chr(34) & motaremplacer & Chr(34) & " a été remplacé par " & Chr(34) & mot & Chr(34) & " (en gras) sur toutes les feuilles"), vbInformation
    End If
    
Else

    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook

    Do
      For k = 0 To 9
      Dim QuestionNomFeuille As String
      QuestionNomFeuille = Trim(InputBox("Saisir le nom de la feuille sur laquelle vous voulez exécuter la macro ?"))
          
          If FeuilleExiste(QuestionNomFeuille) Then
              
              Sheets(QuestionNomFeuille).Select
              
              Dim RepQuestion4 As String
              Dim Question4 As String
    
              Question4 = "Valider ?"
              RepQuestion4 = MsgBox(Question4, vbQuestion + vbYesNo, "Validation")
              
              If RepQuestion4 = vbYes Then
              
              motaremplacer = Trim(InputBox("Entrer le mot à remplacer"))
              mot = Trim(InputBox("Entrer le mot de remplacement"))

              QuestionGras = "Voulez-vous mettre en gras ?"
              RepQuestionGras = MsgBox(QuestionGras, vbQuestion + vbYesNo, "Bold")
              
              Sheets(QuestionNomFeuille).Activate
              
                                    Set oRegExp = CreateObject("vbscript.regexp")
                                    With oRegExp
                                        .Global = True
                                        .ignorecase = False
                                        For Each c In Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row)
                                            .Pattern = "(\s|^)(" & motaremplacer & ")(\s|$)"
                                            c.Font.Bold = False
                                            chaine = c.Value
                                            If .test(chaine) = True Then
                                                Set matches = .Execute(chaine)
                                                c.Value = .Replace(chaine, "$1" & mot & "$3")
                                                chaine = c.Value
                                                .Pattern = "(\s|^)" & mot & "(\s|$)"
                                                If RepQuestionGras = vbYes Then
                                                    Set matches = .Execute(chaine)
                                                    For i = 0 To matches.Count - 1
                                                        c.Characters(Start:=matches.Item(i).firstIndex + 1, _
                                                        Length:=matches.Item(i).Length).Font.Bold = True
                                                    Next i
                                                End If
                                            End If
                                        Next c
                                    End With

            k = 9
            
            If RepQuestionGras = vbNo Then
            MsgBox (Chr(34) & motaremplacer & Chr(34) & " a été remplacé par " & Chr(34) & mot & Chr(34) & " sur la feuille " & Chr(34) & QuestionNomFeuille & Chr(34)), vbInformation
            Else
            MsgBox (Chr(34) & motaremplacer & Chr(34) & " a été remplacé par " & Chr(34) & mot & Chr(34) & " (en gras)" & " sur la feuille " & Chr(34) & QuestionNomFeuille & Chr(34)), vbInformation
            End If
            
            Else
                
            k = 0
            
            End If
          
        Else
            MsgBox (Chr(34) & QuestionNomFeuille & Chr(34) & " n'existe pas"), vbExclamation
            If k = 9 Then
            MsgBox ("Feuille non-trouvée après 10 tentatives. Macro annulée"), vbCritical
            End If
            
        End If
        
    Next
    
Loop While k = 9

End If

End Sub

Encore merci à tous.

Effectuez une recherche sur Excel Downloads...

Macro - Rechercher et mettre en gras

Flow

XLDnaute Nouveau

DoubleZero

XLDnaute Barbatruc

phlaurent55

Nous a quittés en 2020

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

david84

XLDnaute Barbatruc

david84

XLDnaute Barbatruc

Flow

XLDnaute Nouveau

JNP

XLDnaute Barbatruc

Flow

XLDnaute Nouveau

Flow

XLDnaute Nouveau

david84

XLDnaute Barbatruc

Flow

XLDnaute Nouveau

Flow

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums