Modification du formattage d'un texte importé dynamiquement depuis Excel dans un tableau Word

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous,

J'essaye d'obtenir un tableau comme ci-dessous en utilisant des macros VBA depuis Word :
Pièce jointe 154107

Le nombre de domaine et de sous-domaine par domaine varie en fonction des données extraites depuis un fichier Excel.

Mon problème est que le texte de ces tableaux doit correspondre exactement au formattage ci-dessus (couleur, gras).
Pour le moment, j'ai le code suivant (je ne mets que les parties intéressantes) avec certains de mes essais.
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 ''''''''''''''''''' ''ouvrir le fichier excel'' ''''''''''''''''''' Dim chemin, valeur Set exl = CreateObject("excel.application") chemin = ActiveDocument.Path & "\données.xls" exl.Workbooks.Open (chemin) 'exl.Visible = True ''''''''''''''''''''''''''''''''''' ''test pour les lignes du tableau'' ''''''''''''''''''''''''''''''''''' Dim incr, ligne incr = 2 While exl.ActiveWorkbook.Sheets(1).Range("D" & incr) <> "" valeur = exl.ActiveWorkbook.Sheets(1).Range("D" & incr) If incr <> 2 Then 'MsgBox "val: " & valeur & " " & incr Else ActiveDocument.Tables(6).Cell(1, 1).Range.Text = "Domaine : " ActiveDocument.Tables(6).Cell(1, 1).Range.InsertAfter (valeur) ActiveDocument.Tables(6).Cell(1, 1).Range.Select Selection.Find.Format = False Selection.Find.Text = valeur Selection.Find.Execute 'Selection.Font.Color = 192 End If incr = incr + 1 Wend
Je cherche ici à mettre la couleur du nom du domaine en rouge (Color 192) et je me suis inspiré des fonctions rechercher/remplacer sur ce modèle : http://heureuxoli.developpez.com/off...placer/#L2-D-1
J'obtiens dans le cas présent une jolie erreur (je pense que cela provient de mon select) :
Pièce jointe 154108

Quelqu'un aurait-il la solution palliant à cette erreur ou une méthode plus "propre"?

22/08/2014, 11h20
Heureux-oli

Salut,

Je pense qu'il serait plus facile de rechercher le ":" et d'étendre la sélection pour modifier son format.
22/08/2014, 12h03
MyKroPhone

1 pièce(s) jointe(s)

Je veux bien le chercher, mais c'est mon Find qui génère l'erreur sur ce que j'ai Select, et je ne sais malheureusement pas pourquoi ni quelle zone sélectionner.
voici un fichier contenant le tableau d'exemple (j'ai viré tout le reste).
Pièce jointe 154420

Merci d'avance pour la réponse
22/08/2014, 12h13
Heureux-oli

Salut,

Tu fais ton find sur ce qui vient d'excel et je ne sais pas ce qui contient ton range.

Le find se fait sur un string, tout autre contenu lève une erreur.
22/08/2014, 14h10
MyKroPhone

Désolé j'ai dû ne pas être clair alors, mais si tu regardes bien le code fourni, je fais le ".Select" sur le "ActiveDocument" et non sur le "ActiveWorkbook".
J'ai donc déjà réussi à importer le texte comme il faut mais tout est en gras et en noir (comme le premier mot).

Et une fois que le texte est importé avec succès, je cherche à changer le style dans Word pour certaines parties du texte dans le tableau (je me débrouillerai après pour le faire). Mais ta réponse avec le String va m'aider, puisque je vais essayer de tester le type de ce que je "Select". Je n'arrivais juste pas à sélectionner le texte de la cellule.

Range.Value.Select correspondrait? Il me semble que j'avais déjà fait le test.
22/08/2014, 20h19
Heureux-oli

Salut,

Tu recherches çà :

Code:

Selection.Find.Text = valeur

Et valeur est issue de çà :

Code:

valeur = exl.ActiveWorkbook.Sheets(1).Range("D" & incr)

Sans savoir ce que ta cellule contient, c'est une piste que j'entrevois.
Find ne prend en argument qu'un string.

Rebonjour,

Je remonte le post parce que j'ai réussi à résoudre le problème autrement :
Je mets tout d'abord mon texte issu d'Excel dans mon tableau, puis je fais la mise en forme par la suite.
Cela me donne quelquechose du genre :

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
 
Sub AutoOpen()     
    '''''''''''''''''''''''''''
    ''ouvrir le fichier excel''
    '''''''''''''''''''''''''''
    Dim chemin
    Set exl = CreateObject("excel.application")
    chemin = ActiveDocument.Path & "\test.xls"
    exl.Workbooks.Open (chemin)
        ''''''''''''''''''''''''''''''
        ''Remplir le tableau''
        ''''''''''''''''''''''''''''''
        Dim incr, ligne, dom_id, domaine, sdom_id, sdomaine
        ligne = 1
        incr = 4
        While exl.ActiveWorkbook.Sheets(1).Range("A" & incr) <> ""
            dom_id = exl.ActiveWorkbook.Sheets(1).Range("A" & incr)
            domaine = exl.ActiveWorkbook.Sheets(1).Range("B" & incr)
            sdom_id = exl.ActiveWorkbook.Sheets(1).Range("C" & incr)
            sdomaine = exl.ActiveWorkbook.Sheets(1).Range("D" & incr)
            If incr <> 4 Then
                If dom_id = exl.ActiveWorkbook.Sheets(1).Range("A" & incr - 1) Then 'domaine identique, rajout du sous-domaine
                    ActiveDocument.Tables(6).Cell(ligne, 1).Range.InsertAfter (vbCrLf & vbTab & "Sous-domaine : " & sdomaine)
                Else ' changement de ligne car domaine différent
                    ligne = ligne + 1
                    ActiveDocument.Tables(6).Rows.Add
                    ActiveDocument.Tables(6).Cell(ligne, 1).Range.Text = "Domaine : " & domaine
                    ActiveDocument.Tables(6).Cell(ligne, 1).Range.InsertAfter (vbCrLf & vbTab & "Sous-domaine : " & sdomaine)
                End If
            Else 'init
                ActiveDocument.Tables(6).Cell(ligne, 1).Range.Font.Color = 192
                ActiveDocument.Tables(6).Cell(ligne, 1).Range.Text = "Domaine : " & domaine
                ActiveDocument.Tables(6).Cell(ligne, 1).Range.InsertAfter (vbCrLf & vbTab & "Sous-domaine : " & sdomaine)
            End If
            incr = incr + 1
        Wend

Comme on peut le voir dans l'initialisation, j'ai tout mis en rouge de base, afin de n'avoir que les "Domaine :" et "Sous-domaine :" à colorer en noir.
Cela me donne ceci :

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
 
        'recherche sur "Domaine" pour le mettre en noir
        FormFields("TitreMetier").Select 'on se replace au début du document
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Domaine :"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = True
        End With
        For i = 1 To ligne
            Selection.Find.Execute
            Selection.Font.Color = wdColorBlack
        Next
        'recherche sur "Sous-domaine" pour le mettre en noir et en non-gras
        FormFields("TitreMetier").Select 'on se replace au début du document
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Sous-domaine :"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = True
        End With
        For i = 1 To 100 'nombre de sous-domaine à remettre dynamique plus tard
            Selection.Find.Execute
            Selection.Font.Color = wdColorBlack
            'MsgBox Selection
            'Selection.MoveEnd Unit:=wdLine
            'Selection.Extend vbCrLf
            'Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            'MsgBox Selection
            Selection.Font.Bold = False
        Next

Pour le moment tout marche bien. Le petit truc que j'aimerai en plus, c'est dans mon Find sur les sous-domaines, mettre le libellé des sous-domaines à Bold = False, comme pour "Sous-domaine :" (voir le modèle désiré au début).
J'ai essayé avec les options d'extension (commentés dans mon code juste au dessus) :
- pour le 1er et le 3eme, cela sélectionne toute la ligne du tableau
- pour le 2eme, il ne repère pas les vbCrLf (alors que je les ajoute au début moi-même)
J'avais essayé en rajoutant un caractère "µ" à la fin de chaque libellé de sous-domaine, le .Extend "µ" fonctionnait alors bien, mais le Find bouclait entre la Selection et la Selection.Extend (le Find restait sur le même "Sous-domaine :" sans passer au suivant vu que la sélection change).

Avez-vous une solution afin que je puisse mettre mes libellés de sous-domaine sans gras?
Merci d'avance

Rebonjour à tous,

J'ai résolu mon problème tout seul. En effet, mon problème venait du fait que je ne pouvais pas choisir mon style d'écriture au moment où je l'écrivais avec les commandes :

Code:

1
2
3
4
 
ActiveDocument.Tables(6).Rows.Add
ActiveDocument.Tables(6).Cell(ligne, 1).Range.Text = "Domaine : " & domaine
ActiveDocument.Tables(6).Cell(ligne, 1).Range.InsertAfter (vbCrLf & vbTab & "Sous-domaine : " & sdomaine)

Mais j'ai finalement réussi à trouver une magouille pour me placer dans mon tableau et de pouvoir écrire comme je le désire, cela donne maintenant :

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
        Dim incr, ligne, dom_id, domaine, nb_sdom, sdom_id, sdomaine
        ligne = 1
        nb_sdom = 0
        incr = 5
        While exl.ActiveWorkbook.Sheets(1).Range("A" & incr) <> "" 'boucle jusqu'à la fin
            'initialisation des variables
            dom_id = exl.ActiveWorkbook.Sheets(1).Range("A" & incr)
            domaine = exl.ActiveWorkbook.Sheets(1).Range("B" & incr)
            sdom_id = exl.ActiveWorkbook.Sheets(1).Range("C" & incr)
            sdomaine = exl.ActiveWorkbook.Sheets(1).Range("D" & incr)
            If incr <> 5 Then ' n'est pas la première ligne
                ' vérification que la ligne ne se répète pas (déjà écrite)
                If dom_id <> exl.ActiveWorkbook.Sheets(1).Range("A" & incr - 1) Or sdom_id <> exl.ActiveWorkbook.Sheets(1).Range("C" & incr - 1) Then
                    If dom_id = exl.ActiveWorkbook.Sheets(1).Range("A" & incr - 1) Then 'même ligne car même domaine
                        'écriture sous-domaine
                        Selection.Font.Color = 192
                        Selection.TypeText Text:=vbCrLf & vbTab & "Sous-domaine : "
                        Selection.Font.Color = wdColorBlack
                        Selection.TypeText Text:=sdomaine
                    Else ' changement de ligne car domaine diff
                        ligne = ligne + 1
                        ActiveDocument.Tables(5).Rows.Add
                        ' placement curseur
                        Selection.MoveDown Unit:=wdLine, Count:=1
                        'écriture domaine
                        Selection.Font.Bold = True
                        Selection.Font.Color = 192
                        Selection.TypeText Text:="Domaine : "
                        Selection.Font.Color = wdColorBlack
                        Selection.TypeText Text:=domaine
                        'écriture sous-domaine
                        Selection.Font.Bold = False
                        Selection.Font.Color = 192
                        Selection.TypeText Text:=vbCrLf & vbTab & "Sous-domaine : "
                        Selection.Font.Color = wdColorBlack
                        Selection.TypeText Text:=sdomaine
                    End If
                End If
            Else 'initialisation du tableau + couleur
                ' placement curseur
                ActiveDocument.Tables(5).Cell(1, 1).Select
                Selection.MoveUp Unit:=wdLine, Count:=1
                Selection.MoveDown Unit:=wdLine, Count:=1
                'écriture domaine
                Selection.Font.Bold = True
                Selection.Font.Color = 192
                Selection.TypeText Text:="Domaine : "
                Selection.Font.Color = wdColorBlack
                Selection.TypeText Text:=domaine
                'écriture sous-domaine
                Selection.Font.Bold = False
                Selection.Font.Color = 192
                Selection.TypeText Text:=vbCrLf & vbTab & "Sous-domaine : "
                Selection.Font.Color = wdColorBlack
                Selection.TypeText Text:=sdomaine
            End If
            nb_sdom = nb_sdom + 1
            incr = incr + 1
        Wend

J'utilise donc la sélection en sélectionnant la première ligne de mon tableau, puis en simulant un appui sur la flèche du haut, puis sur la flèche du bas, afin de positionner mon curseur dans mon tableau (que j'ai préalablement nettoyer). Cela me permet ensuite d'utiliser Selection.Font et Selection.TypeText.
Ca rallonge mon code, mais il parait que plus c'est long plus c'est bon :roll:

Voilà, en espérant que ça puisse dépanner des gens.

Bonne journée à tous !!

PS : c'est vraiment la merde comparé au VBA sur Excel :aie: