Discussion :

[nouvelinscrit]

Bonjour,

Je cherche a réaliser une macro permettant de détecter dans un tableau le caractère "*", et si il est trouvé, rajouter au début du tableau des cases vides dans lequels je rajouterai ensuite un en-tête.

Lors d'une question sur un autre forum, on m'avait conseillé le script suivant :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*"
.Replacement.Text = ""
.Wrap = wdFindContinue
End With
Selection.Find.Execute
While Selection.Find.Found
Selection.InsertRowsAbove 1
Selection.Find.Execute
Wend

Mais il y a un probleme dans cette macro, c'est que qd j'ai plusieurs caractères "*", je rentre dans une boucle infinie et Word me rajoute sans arret des lignes.
J'ai l'impression (quand je ne met qu'un seul "*" et que ca marche) que c'est parce que le "*" n'est pas supprimé et donc il rajoute toujours une nouvelle ligne.
Le problème c'est que normalement il y a la commande Replacement.Text = "" pour supprimer le *, mais visiblement ca ne fait rien.

Vous auriez une idée ?

Merci

[Heureux-oli]

Salut,

Ce "*" peut-il être dans n'importe quelle cellule du tableau ou dans un cellule précise.

[nouvelinscrit]

Le "*" peut etre dans n'importe quelle cellule (enfin il serait dans la 1ere colonne, mais il peut y avair plusieurs tableaux)

[Heureux-oli]

Salut,

Essaies ce morceau de 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
 
Sub AjouterLigneTableau()
Dim oTbl As Table
 
For Each oTbl In ActiveDocument.Tables
    oTbl.Select
    With Selection.Find
        .Text = "*"
        .Forward = True
 
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then Selection.InsertRowsAbove 1
 
    Debug.Print Selection.Find.Found
Next oTbl
 
End Sub

[nouvelinscrit]

Merci ! votre code marche bien, mais il rajoute des lignes juste au dessus du caractere *. Moi (mais j'avais oublié de le préciser) je voudrais en rajouter que si c'est la case de plus haut niveau qui a un "*")

A partir de votre code, j'ai essayé le code suivant:

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
Sub AjouterLigneTableau()
Dim oTbl As Table
 
For Each oTbl In ActiveDocument.Tables
    oTbl.Select
    With Selection.Find
        .Text = "*"
        .Replacement.Text = ""
        .Forward = True
 
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then
        Selection.MoveUp
        If Selection.Find.Text = "" Then
            Selection.InsertRows
            Selection.TypeText Text:="Colonne1"
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.TypeText Text:="Colonne2"
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.TypeText Text:="Colonne3"
        End If
    End If
 
    Debug.Print Selection.Find.Found
Next oTbl
 
End Sub

Mais ca ne me donne plus rien
Comment est ce que je pourrai arranger ca ?

[Heureux-oli]

Salut,

il donne rien, mais ne ressemble à rien non plus

Essaie comme çà :

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
 
Sub AjouterLigneTableau()
Dim intT As Integer
 
 
For intT = 1 To ActiveDocument.Tables.Count
 
    ActiveDocument.Tables(intT).Select
    With Selection.Find
        .Text = "*"
        .Forward = True
 
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then ActiveDocument.Tables(intT).Rows.Add ActiveDocument.Tables(intT).Rows(1)
 
 
    Debug.Print Selection.Find.Found
Next intT
 
End Sub

[nouvelinscrit]

je réponds un peu tard, mais merci beaucoup !

[Sepia]

Salut NouvelInscrit,

Si ton problème est résolu, cliques sur le bouton , ça permet à d'autres DVPnautes de savoir qu'il y a une réponse et ça nous évite de répondre plusieurs fois la même chose (enfin en théorie).

@+