Effacement des styles Word

**luxmen** · 12/01/2006, 17h23

Salut,

J'ai trouvé sur ce forum une bonne macro pour supprimer tout les styles inutilisés d'un document.

Mais ma question est simple, je voudrais tous les supprilmer, mais avec des exceptions, comme : "garamond_gras" et "times_ten_ital" qui ne se trouvent pas dans mon doc, mais que je veux garder.

comment dois je modifier ce code ? :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Supp_Styles_Click()
'
' Enlever Tous les Styles inutilisés du document actif
'
Dim S As Style
Dim msg As String
Dim MonDoc As Document
Set MonDoc = ActiveDocument
 
    For Each S In MonDoc.Styles
    If S.InUse = True Then
 
    With MonDoc.Content.Find
    .ClearFormatting
    .Text = ""
    .Style = S
    .Execute Format:=True
If .Found = True Then
 
    Else
    On Error Resume Next
    S.Delete
    On Error GoTo 0
End If
End With
End If
Next S
 
End Sub

Thx a vous

**ouskel'n'or** · 12/01/2006, 19h16

Voilà qui marche

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub StylesRechercheDes()
Dim S As Style
Dim msg As String
Dim MonDoc As Document
Set MonDoc = ActiveDocument
  For Each S In MonDoc.Styles
    i = i + 1
    Set NomStyle = ActiveDocument.Styles(i)
    With NomStyle
      NomDuStyle = .NameLocal
    End With
    If MonDoc.Styles(NomDuStyle).InUse = True Then
      ok = InStr(LCase(NomDuStyle), "07_signature_nom") = 0
      ok = ok And InStr(LCase(NomDuStyle), "06_tableau_texte_gauche") = 0
      ok = ok And InStr(LCase(NomDuStyle), "02_intertitre_1._gras") = 0
      ok = ok And InStr(LCase(NomDuStyle), "02_intertitre_a)_ital") = 0
      ok = ok And InStr(LCase(NomDuStyle), "02_intertitre_A._bdc_gras_ital") = 0
      ok = ok And InStr(LCase(NomDuStyle), "02_intertitre_I._rom_cap") = 0
    End If
    If ok Then
      ok = MsgBox("Effacer " & ActiveDocument.Styles(i).NameLocal, vbYesNo) = 6
      If ok Then MonDoc.Styles(NomDuStyle).Delete
    End If
  Next S
  Set NomStyle = nothing
  Set MonDoc = Nothing
End Sub

Quand tu es sûr de toi, tu enlèves le msgbox

A+

**luxmen** · 12/01/2006, 22h25

Re ouskel'n'or,

désolé, mais je suis aller faire une petite sieste !! (et oui, je me lève super tot pour le boulot :-))

Ca a l'aire de beaucoup mieux marcher, mais j'ai "encoore" une chtite question !

il y a une erreur lorsque'il arrive sur les "styles en dur" de word que l'on ne peut pas supprimer (les styles du type) :

"1 / 1.1 / 1.1.1"
"1 / a / i"
"Article / Section"

etc...

Aurais tu un moyen magique pour eviter ca ?

Merci grand chef ouskel'n'or !!

**ouskel'n'or** · 13/01/2006, 10h36

il y a une erreur lorsque'il arrive sur les "styles en dur" de word

Les styles dont tu parles concernent (je crois) les tables et index.
Auquel cas, puisque tu ne peux les supprimer, et si le reste fait ce que tu veux... tu peux remettre le On error resume next

Suffit que tu fasses un test sur err pour ignorer le style en question.

Code :

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

1
2
3
4
5
6
7
    If ok Then 
      ok = MsgBox("Effacer " & ActiveDocument.Styles(i).NameLocal, vbYesNo) = 6 
      on error resume next
      If ok Then MonDoc.Styles(NomDuStyle).Delete
      err.clear 
      on error goto 0
    End If

Si tu souhaitais les effacer aussi, je n'ai pas de solution.

A+

**ouskel'n'or** · 13/01/2006, 11h08

Juste une remarque :
Si tu modifies les styles, attention de ne pas enregistrer le modèle modifié lors de la fermeture de Word.
Si tu as résolu ce problème, comme je n'y ai jamais été confronté, tu peux nous dire comment tu as fait ?

Merci

A+

**luxmen** · 13/01/2006, 14h21

Salut !!

Je suis sur que tu vas me tapper sur les doigts...mais j'ai encore une dernière petite question (je suis chiant là

).

J'ai préféré rentrer tout les styles du ".dot", dans la macro, pour être sur que tout les styles seront supprimés, mais pas ceux du ".dot", le problème est que ca marche au poil, sauf pour 2 styles :

**02_intertitre_I._rom_cap
**02_intertitre_A._bdc_gras_ital

Ces deux styles s'effacent même s'il sont dans la composition...

je te montre la macro :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub StylesRechercheDes1()
Dim S As Style
Dim msg As String
Dim NomduStyle As Style
 
  For Each S In ActiveDocument.Styles
    i = i + 1
    Set NomduStyle = ActiveDocument.Styles(i)
    With NomduStyle
    NomduStyle = .NameLocal
    End With
    If ActiveDocument.Styles(NomduStyle).InUse = True Then
 
            ok = InStr(LCase(NomduStyle), "**00_gras_car") = 0
 
            ok = ok And InStr(LCase(NomduStyle), "**00_gras_ital_car") = 0
            ok = ok And InStr(LCase(NomduStyle), "**00_ital_car") = 0
            ok = ok And InStr(LCase(NomduStyle), "**01_m_mme_maitres...") = 0
            ok = ok And InStr(LCase(NomduStyle), "**01_nor_reference") = 0
            ok = ok And InStr(LCase(NomduStyle), "**01_nor_reference_ital_car") = 0
            ok = ok And InStr(LCase(NomduStyle), "**01_rapporteur") = 0
            ok = ok And InStr(LCase(NomduStyle), "**01_titre_avis") = 0
            '---------------------------------------------------------------------------
            ok = ok And InStr(LCase(NomduStyle), "**02_intertitre_1._gras") = 0
            ok = ok And InStr(LCase(NomduStyle), "**02_intertitre_a)_ital") = 0
            ok = ok And InStr(LCase(NomduStyle), "**02_intertitre_A._bdc_gras_ital") = 0
            ok = ok And InStr(LCase(NomduStyle), "**02_intertitre_I._rom_cap") = 0
            '---------------------------------------------------------------------------
            ok = ok And InStr(LCase(NomduStyle), "**02_intertitre_petites_cap") = 0
            ok = ok And InStr(LCase(NomduStyle), "**02_intertitre_romain_bdc") = 0
            ok = ok And InStr(LCase(NomduStyle), "**03_texte_courant") = 0
            ok = ok And InStr(LCase(NomduStyle), "**03_texte_courant_av_sign") = 0
            ok = ok And InStr(LCase(NomduStyle), "**03_texte_num_auto") = 0
            ok = ok And InStr(LCase(NomduStyle), "**05_enum_iii") = 0
            ok = ok And InStr(LCase(NomduStyle), "**05_enum_sans_tiret") = 0
            ok = ok And InStr(LCase(NomduStyle), "**05_enum_tiret") = 0
            ok = ok And InStr(LCase(NomduStyle), "**05_sous_enum_tiret") = 0
            ok = ok And InStr(LCase(NomduStyle), "**06_tableau_entete") = 0
            ok = ok And InStr(LCase(NomduStyle), "**06_tableau_note") = 0
            ok = ok And InStr(LCase(NomduStyle), "**06_tableau_texte") = 0
            ok = ok And InStr(LCase(NomduStyle), "**06_tableau_texte_gauche") = 0
            ok = ok And InStr(LCase(NomduStyle), "**06_tableau_titre") = 0
            ok = ok And InStr(LCase(NomduStyle), "**07_signature_fonction") = 0
            ok = ok And InStr(LCase(NomduStyle), "**07_signature_ministre") = 0
            ok = ok And InStr(LCase(NomduStyle), "**07_signature_nom") = 0
            ok = ok And InStr(LCase(NomduStyle), "**08_decision") = 0
            ok = ok And InStr(LCase(NomduStyle), "**09_appel_note_car") = 0
            ok = ok And InStr(LCase(NomduStyle), "**09_note") = 0
            ok = ok And InStr(LCase(NomduStyle), "Lien hypertexte") = 0
    End If
'
    If ok Then
 
      On Error Resume Next
      If ok Then ActiveDocument.Styles(NomduStyle).Delete
 
      On Error GoTo 0
'
    End If
  Next S
 
End Sub

Comme tu le voit j'ai pleins de styles (tous avec des asterix), et seul les 2 cités plus haut ne reagissent pas a la macro...

Pense tu que cela soit du a l'orthographe de ces styles ?

Je te souhaite un Xellent week-end

**ouskel'n'or** · 13/01/2006, 15h54

Bien sûr, m'étonne pas... Relis ces deux lignes :

**02_intertitre_I._rom_cap
**02_intertitre_A._bdc_gras_ital

Lcase sert à mettre la donnée lue en minuscule, dans tes deux styles récalcitrants, tu as une majuscule... Même si VBA le voulait, y pourrait pas...
Tu as plusieurs méthodes pour corriger ça mais je te mets la plus simple sinon la plus rapide en terme d'exécution.

Code :

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

1
2
            ok = ok And InStr(LCase(NomduStyle), Lcase("**02_intertitre_I._rom_cap")) = 0 
            ok = ok And InStr(LCase(NomduStyle), lcase("**02_intertitre_A._bdc_gras_ital ")) = 0

Tu mets ça partout car si je regarde bien, dans "Lien hypertexte" il y a aussi une majuscule

A+

Dis si ça marche

**luxmen** · 13/01/2006, 17h12

Hip Hip Hip ....................Hourra !

Genial, ca marche au petit oignons :-)

je suis obliger de relancer la macro 3 ou 4 fois dans un call, pour supprimer tout les styles inutiles, mais ca marche au top !

PS : pour la peine je vais jouer a l'euro million (et oui, on dirait que le vendredi 13 est un jour de chance pour moi !)

Un GRRRAAANNNDDD merci a toi ouskel'n'or pour ton aide précieuse !

**ouskel'n'or** · 13/01/2006, 17h32

Si tu gagnes, je te passerai mon adresse... Moi, je ne joue pas...

PS - J'suis pas fou, je fais des stats à longueur de tps...

Effacement des styles Word

VBA Word

Discussions similaires

Partager

Partager