selection par formatage [Résolu]

[jacques732]

Bonjour,
je vous ecris car je n'ai pas trouve la reponse a ma question dans la FAQ.
Je souhaite faire une macro word afin de formater un document .doc
Celui est deja formate d'une maniere particuliere (titre en gras, 14 , arial ; nom de l'auteur en italique, 12, arial...) car il est genere par exportation depuis une base de donnees.
Je voudrais donc recuperer chaque partie formatee d'une maniere particuliere et la formater directement.
CEpendant, je n'ai pas trouve a quel objet appliquer Selection pour faire cela.

Un exemple, j'ai 5 titres de films formates de la meme maniere :

A la place du coeur ; L'argent fait le bonheur
réalisé par et scénario de et adapté par Robert Guédiguian ; adapté de James Baldwin ; scénario de et adapté par Jean-Louis Milesi ; Arianne Ascaride et Alexandre Ogou et Laure Raoust et Jean-Pierre Darroussin et Jean-Jérôme Esposito , interprète.
Agat films, 0199.
Genre : DVDF.


Je veux 1- selectionner tous les titres formates comme "A la place du coeur ; L'argent fait le bonheur "
2- Formater cette selection en Noir, gras italique
3- Pour cette selection apres le point virgule je veux mettre un espace et supprimer le point virgule

Mon probleme se pose sur , comment faire la selection de la ligne avec un formatage particulier donc (mon petit 1)

Merci beaucoup d'avance
Bonne journée

[tazamorte]

voici un bout de code qui devrait te permettrai d'avance

Code :

1
2
3
4
5
6
7
8
9
10
11
 
dim myselect as string
Set myRange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For Each aWord In myRange.Words
    If aWord.Font = "Arial" Then 
myselect= myselect & aWord 
else
'traitement sur ta selection vire la virgule je ne sais quoi et met le formatage
end if
 
Next aWord

ceci est un exemple de code non testé à toi de jouer

[jacques732]

MErci beaucoup,
j'etudie ca

[jacques732]

Rebonjour,

je me remets dans mes macros, et apprends sur le tas les objets selection etc. J'essaye toujours d'utiliser Visual Basic sous word avec mon probleme du 1er post
J'ai essayé la bout de code plus haut, proposé par Tazamorte, mais j'ai une erreur pour

Code :

If aWord.Font = "Arial" Then

Visual BAsic me renvoit

"L'objet n'admet pas cette méthode ou propriété."

(j'ai Word 2003 et VB 6.3 1987-2001)
J'ai donc essayé de trouver des choses sur l'objet 'aWord' mais ma recherche n'a pas été fructueuse. Mon problème c'est donc de sélectioner mot par mot ma selection (Range), pour regarder quelle police est utilisée et l'ajouter à ma sélection si c'est du Arial.

J'ai essayé une autre technique (avec une boulcle) mais je ne sais pas comment selectionner un seul mot. J'ai pensé à un truc du genre (inspiré de ce qui est mis plus haut), mais qui est faux à cause de ce que je ne sais pas faire:

Code :

1
2
3
4
5
6
7
8
9
 
dim myselect as string
Set myRange = ActiveDocument.Range(Start:=0, End:=Selection.End)
NbMot=myRange.Words.Count
   For i As Integer = 1 To NbMot
           if myRange.Words.style="Arial" then   'c'est là que je ne suis pas du 
                       'tout sur de ne selectionner qu'un seul mot
           myselect= myselect & myRange.Words.style
   Next i

Merci d'avance pour votre aide,
bonne journée

[Speedrman]

voilà pour parcourir le document mot par mot

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Macro2()
 
  Dim locIntEnd As Integer
 
  Selection.EndKey wdStory, wdMove  'déplace la sélection à fin du document
  locIntEnd = Selection.Range.End   'position du dernier caractère
  Selection.HomeKey wdStory, wdMove 'déplace la sélection au début du document
 
  Do
      Selection.MoveRight wdWord, 1, wdExtend
'      Traitement
'      ...
'      ...
      Selection.MoveRight wdCharacter, 1, wdMove
  Loop While Selection.Range.End <> locIntEnd
 
End Sub

[jacques732]

J'ai bien utilisé tout ce que vous m'avez donné, maintenant mon code ressemble à ca :

Code :

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
Sub Macro2()
'
' Macro2 Macro
' Macro creada el 28/05/2007 por IFM
'
 
 
1- Dim locIntEnd As Integer
 
2- Selection.EndKey wdStory, wdMove 'déplace la sélection à fin du document
3- locIntEnd = Selection.Range.End 'position du dernier caractère
4- Selection.HomeKey wdStory, wdMove 'déplace la sélection au début du document
 
5- Do
6- Selection.MoveRight wdWord, 1, wdExtend
7-    Select Case Selection.Font.Color
8-        Case Black
9-            If Selection = "/ " Then
10-                Selection = wdLine
11-           End If
12-           Selection.Font.Size = 12
13-            Selection.Font.Bold = True
14-            Selection.Font.Italic = True
15-        Case Blue
16-            Selection.Font.Size = 11
17-            Selection.Font.Bold = True
18-        Case Olive
19-            Selection.Font.Size = 9
20-            Selection.Font.Bold = True
21-            Selection.Font.Bold = False
22-     End Select
 
23-Selection.MoveRight wdCharacter, 1, wdMove
24-Loop While Selection.Range.End <> locIntEnd
 
 
End Sub

J'ai malheureusement encore 2 problèmes :
Tout d'abord ligne 9 et 10

Code :

1
2
    If Selection = "/ " Then
                Selection = wdLine

donne une boucle infinie , selon les fois sans que j'ai réussi à comprendre la logique. Et je ne suis pas tout à fait sur de mon wdLine (le but c'est de remplacer "/" par un passage à la ligne, et j'ai trouvé wdLine pour passer à la ligne 8j'ai essayé egelement \n sans succès.

Et ensuite mon code marche sur un petit fichier doc (de 1 ou 2 page) mais quand j'ai un gros fichier (genre un fichier trop grand, de 20 pages). Pour ce problème, je suppose que c'est la méthode mot par mot qui est trop longue, et je ne sais pas s'il y a une solution simple.

Merci encore d'avance de votre aide,
a bientot

[ouskel'n'or]

Essaie en ajoutant

Code :

1
2
3
4
22-     End Select
22bis   Selection.ExtendMode = False    
23-Selection.MoveRight wdCharacter, 1, wdMove
24-Loop While Selection.Range.End <> locIntEnd

Tu dis
A+

Edit
Je viens de regarder, tu dois ajouter Unit:=1

Code :

Selection.MoveEnd Unit:=wdLine, Count:=1

A+

[jacques732]

Merci, ouskel'n'ord,

jai essayé de rajouter ta ligne 22bis, et ce que tu m'avais donné en ligne 10; ce qui donne :

Code :

1
2
 9-  If Selection = "/ " Then
10-  Selection.MoveEnd Unit:=wdLine, Count:=1

Ma boucle n'est plus infinie ( ce qui est plutot une bonne nouvelle et m'a grandement réjouit), mais ca ne fait pas ce que je veux ( à savoir supprimer "/" et à la place passer une ligne), Je crois qu'actuellement ca passe juste la ligne à la fin du paragrahe, et ca n'efface pas le slashe.
Après je dois dire que j'ai de fort doutes sur la justesse de mon

Code :

If Selection = "/ "

qui exprime "si l'bjet sélectionné est egale au caractere "slashe+espace"

En tous cas merci encore,
je galère plutot

Bonne journée
+++

[ouskel'n'or]

Ok, je n'avais pas tout relu, simplement ton problème de boucle infinie.
Ce que tu dois faire, c'est sélectionner ce foutu "/" et écrire ""

Code :

1
2
3
4
5
Selection.typetext text:="" 
'ou 
Selection.typetext text:=vbcr 'si tu veux insérer une ligne
'ou
Selection.typeParagraph 'sans doute la syntaxe la plus correcte

Ceci avant d'aller en fin de ligne.
Là je n'ai pas le temps de tout relire et te mettre le code complet mais si tu as une dificulté, il y aura bien quelqu'un pour t'aider. Sinon, je reviens
A+

[jacques732]

Bon, merci, je suis désolé j'ai l'impression de trébucher à chaque pas. Mon problème aussi c'est que je n'ai pas trouvé de bibliothèque correcte pour les mots (mon aide vb ne marche pas) et du coup j'arrive pas à avoir les propriétés des mots clefs, notament de vbCr ou TypePAragraph.

Du coup quand je fais ce que tu me dis

Code :

1
2
3
4
8-        Case Black
9-            If Selection = "/ " Then
10-                Selection.TypeText Text:="" 
11-           End If

Tout va bien (sauf qu'il ne me vire pas le "/")

Et par contre

Code :

1
2
3
4
5
6
8-        Case Black
9-            If Selection = "/ " Then
10-                Selection.TypeText Text:=vbCr
 
ou 10- Selection.TypeParagraph
11-           End If

qui fait vraiment ce que je veux (il me passe la ligne, sans me virer le "/"
je me retrouve encore avec ma boucle infine. Et pourtant j'ai bien mis
Selection.ExtendMode = False
à la fin (ligne 22 bis)


Bon, j'ai encore l'impression de me galérer.
Merci en tous cas pour toute aide et les aides deja données.

Bonne journée

[Speedrman]

Est ce que, en debug, tu passes bien dans la condition ?

Code :

1
2
3
If Selection = "/ " Then
'qu'il serait d'ailleurs préférable d'écrire
If Selection.Range.Text = "/ " Then

Si tu as une boucle infinie, pourrrais-tu mettre la ligne de ton document ou le mot en particulier qui fait que ça boucle ?

Ensuite, es-tu sur que ça marche le

Code :

1
2
Select Case Selection.Font.Color
    Case Black

Quelle est la valeur de la variable "Black" ?

[jacques732]

Salut Speedrman,
merci de m'aider

je te mets mon code en entier (que j'ai un peu nettoyé)

Code :

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
 
 Dim locIntEnd As Integer
 
 Selection.EndKey wdStory, wdMove 'déplace la sélection à fin du document
locIntEnd = Selection.Range.End 'position du dernier caractère
Selection.HomeKey wdStory, wdMove 'déplace la sélection au début du document
 
'là c'est ma boucle
Do
Selection.MoveRight wdWord, 1, wdExtend
    Select Case Selection.Font.Color
        Case wdColorBlack
            If Selection.Range.Text = "/ " Then
               Selection.TypeParagraph
            End If
            Selection.Font.Size = 12
            Selection.Font.Bold = True
            Selection.Font.Italic = True
        Case wdColorBlue
            Selection.Font.Size = 11
            Selection.Font.Bold = True
        Case wdColorOlive
            Selection.Font.Size = 9
            Selection.Font.Bold = True
            Selection.Font.Bold = False
     End Select
Selection.ExtendMode = False
Selection.MoveRight wdCharacter, 1, wdMove
Loop While Selection.Range.End <> locIntEnd
 
 
End Sub

Mes changements de formattage marchent (donc mes selections aussi et mes Case Black, que j'ai changé plus proprement en Case wdColorBlack - ma variable que je teste c'est Selection.Font.Color) et si je ne mets pas mon

Code :

1
2
3
If Selection.Range.Text = "/ " Then
               Selection.TypeParagraph
            End If

je n'ai pas de boucle infinie


Foilà,
bonne journée à vous

[ouskel'n'or]

Je viens de remarquer un "truc" : Quand tu mets

Selection.MoveRight wdWord, 1, wdExtend

Tu ne sélectionnes qu'un caractère, or tu mets ensuite

If Selection.Range.Text = "/ " Then

Déjà, tu pourrais corriger ça.
Ensuite ? Ben je sais pas
Je t'envoie déjà ça...

[jacques732]

Bonjour,

merci pour la réponse.
En fait j'ai fait plus simple avec un script que j'ai trouvé. Au lieu de passer mot par mot, je passe tout le texte directement

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 
Selection.HomeKey unit:=wdStory
ScreenUpdating = False
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = True
    .Text = " / "
    .Replacement.Text = "^p"
    .Forward = True
    .Execute Replace:=wdReplaceAll
End With

En tous cas merci pour les reponses, ca aide vraiment,
bonne journee

[ouskel'n'or]

Ça, c'est le problème de "Bien exposer son problème"
Tu aurais mis :

Comment remplacer "/ " par un saut de ligne dans tout le document"

tu aurais eu tout de suite autant de réponses que de visiteur -1
C'est donc Résolu ? Un petit clic sur et on considérera le pb comme résolu

[jacques732]

oui, merci beaucoup pour l'aide en tous cas.
Heu, j'ai pas trouvé le bouton résolu, je sais pas si c'est la journée qui est dure

Bonne journée