Discussion :

[mick49]

Bonjour,

Je dois réaliser un publipostage d'une grosse base de données contenant des champs de type mémo.

Ce type de champ contient du texte qui devrait avoir après publipostage la forme suivante :

Premiere phrase (optionnelle) :

• Premier item
• Second item
  • preime item (optionel)
  • second ...
• troisieme item (optionnel)

Or dans Access mon champ est du texte brute, donc je ne peux obtenir aucune mise en page. J'ai également essayer avec Access 2007 mais j'obtiens le code html.

Alors ma question est : est-il possible d'utiliser des macro (je ne sais pas faire) pour insérer du code (comme html ou autre) de mise en page (a l'instar des templates des sites web) pour les remplacer par une mise en forme (l'idéal l'application d'un style) ?

Merci beaucoup

et surtout auriez-vous quelques pistes, tuto ou exemple ?

[Heureux-oli]

Pistes, oui, mais exemple non.

On peut à l'aide de macro mettre en forme le texte.
Mais je pense qu'il faudra passer par le code et plus simplement du publipostage.

[mick49]

Tout d'abord merci de la réponse et de sa rapidité

et c'est quoi comme code ? du VBA pour faire un macro ? (j'ai jamais fait ce type de code)

Donc je pourrais faire mon publipostage, puis appliquer le code pour mettre en forme ?

[Heureux-oli]

Malheureusement, ce n'est pas simple, le texte se trouve toujours dans le champ lorsque le document est terminé.

[mick49]

oui c'est bien mon problème : c'est pas simple et je connais pas le langage

Mais admettons que si j'arrive a avoir dans word cette ligne

Code :

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

[MONSTYLE]texte a mettre en forme avec le style nommé mon style[/MONSTYLE]

Est-il possible de trouver une macro, ou autre pour appliquer le style à "texte a mettre en forme avec le style nommé mon style" et aussi a supprimer (ou remplacer par un blanc [MONSTYLE] et [/MONSTYLE]

[Heureux-oli]

Oui, c'est tout a fait possible.
Mais comme je l'ai indiqué, on ne pourras plus faire du publipostage conventionnel.
Jette un oeil ici

[mick49]

Alors voila en utilisant le tutot ici j'ai presque résolu mon problème

j'ai crée (d'apres le tuto) les macro suivante

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
Sub Main()
RemplacementGras
efface "<b>"
efface "</b>"
RemplacementItalique
efface "<i>"
efface "</i>"
Remplacementsouligner
efface "<u>"
efface "</u>"
End Sub
 
 
Sub RemplacementGras()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            With .Find
                .Text = "<b>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</b>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                Selection.Font.Bold = True
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
 
 
Sub efface(chaine)
 Set myRange = ActiveDocument.Content
With myRange.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = chaine
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
End With
End Sub
 
 
Sub RemplacementItalique()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            With .Find
                .Text = "<i>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</i>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                Selection.Font.Italic = True
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
Sub Remplacementsouligner()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            With .Find
                .Text = "<u>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</u>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                Selection.Font.Underline = wdUnderlineSingle
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub

j(ai laisser les affichages pour le deboggage car cela fonctionne pas correctement

effectivement le texte

<b>Gras simple</b>
<u>souligner sur plusieurs mots.</u>
<i>italique sur plusieurs mots.</i>

<b>gras
sur
plusieurs lignes
</b>

donne

Gras simple
souligner sur plusieurs mots.
italique sur plusieurs mots.

gras
sur
plusieurs lignes

Pas tout a fait ce qu'il faut. Dd ce que j'ai vu cela provient du fait qu'au deuxieme appel de mise en forme (cad RemplacementItalique) la selection debute là ou il avait fait le dernier remplacement et non pas à la première balise <i> comme je le voudrais, alors que si j'appelle les trois à la main ca marche !!

Une idée ?

EDIT : j'ai deja mis toutes mes procédures efface à la fin mais cela change rien

[Heureux-oli]

Oui, une idée.
Tu peux sur la recherche des balises placer des signets et ces signets peuvent définir une plage pour la mise en forme du texte

Avec Start et End.

[mick49]

Voila sa marche parfaitement, c'était bien un problème d'initialisation de la zone de sélection

voici le code qui fonctionne :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
Sub Main()
RemplacementGras
RemplacementItalique
Remplacementsouligner
efface "<u>"
efface "</u>"
efface "<b>"
efface "</b>"
efface "<i>"
efface "</i>"
End Sub
 
 
Sub RemplacementGras()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            .ExtendMode = False
            With .Find
                .Text = "<b>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
 
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</b>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                Selection.Font.Bold = True
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
 
 
Sub efface(chaine)
 Set myRange = ActiveDocument.Content
With myRange.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = chaine
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
End With
End Sub
 
 
Sub RemplacementItalique()
 
Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            .ExtendMode = False
            With .Find
                .Text = "<i>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</i>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                Selection.Font.Italic = True
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
Sub Remplacementsouligner()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
        .ExtendMode = False
            With .Find
                .Text = "<u>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</u>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                Selection.Font.Underline = wdUnderlineSingle
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub

Alors une dernière petite question : est-il possible de lancer automatiquement la macro après le publipostage ?

Maintenant, je vais compléter le code sur le meme principe par une macro de remplacement de <style="MonStyle"></style> par l'application du style au texte entre les balises

[Heureux-oli]

Malheureusement, l'évènement publipostage n'est pas un évènement géré par Word.
Donc la réponse est non.

[mick49]

Très bien, donc à penser à lancer à la main mais cela me va,

Je ferais un dernier post avec le changement de style, (pour les curieux) et je marquerais résolu au topic

[mick49]

Donc voila mon code, il suffit de lancer la macro main :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 
Sub Main()
RemplacementStyle
RemplacementGras
RemplacementItalique
Remplacementsouligner
effaceDunTextEntreBalises
End Sub
 
 
Sub RemplacementGras()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            .ExtendMode = False
            With .Find
                .Text = "<b>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
 
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</b>"
                    .Forward = True
                    .Execute
                End With
                Selection.Font.Bold = True
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
 
Sub RemplacementItalique()
 
Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            .ExtendMode = False
            With .Find
                .Text = "<i>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</i>"
                    .Forward = True
                    .Execute
                End With
                Selection.Font.Italic = True
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
Sub Remplacementsouligner()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
        .ExtendMode = False
            With .Find
                .Text = "<u>"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "</u>"
                    .Forward = True
                    .Execute
                End With
                Selection.Font.Underline = wdUnderlineSingle
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
 
    Loop
End Sub
 
 
Sub RemplacementStyle()
 Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            .ExtendMode = False
            With .Find
                .Text = "<style="
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            If Not fin Then
            .MoveRight unit:=wdCharacter, Count:=2
            .ExtendMode = True
                With .Find
                    .Text = """>"
                    .Forward = True
                    .Execute
                End With
                .MoveLeft unit:=wdCharacter, Count:=2
                styleautilise = Selection.Text
                MsgBox Mid(styleautilise, 1, Len(Selection.Text))
                .ExtendMode = False
                With .Find
                    .Text = "<style="
                    .Forward = False
                    .Execute
                End With
                .MoveLeft unit:=wdCharacter, Count:=9
                .ExtendMode = True
             If Not fin Then
              With .Find
                    .Text = "</style>"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 1, Len(Selection.Text))
                Selection.Style = ActiveDocument.Styles(styleautilise)
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
            End If
        End With
 
    Loop
End Sub
 
 
 
Sub effaceDunTextEntreBalises()
    Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            .ExtendMode = False
            With .Find
                .Text = "<"
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = ">"
                    .Forward = True
                    .Execute
                End With
                Selection.Text = ""
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
    Loop
End Sub

Puis effaceDunTextEntreBalises encore une a deux fois selon l'imbrication réalisé