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
|
Sub AjouterLesSignets(ByVal DocEnCours As Document)
'Pour ajouter les points d'insertions des textes et table à copier
Dim MonSignetRange As Range
Dim MonSignetNom As String
With DocEnCours
'Emplacement du Texte du paragraphe "Documents de referencre"
Selection.EndKey Unit:=wdStory 'Pour aller à la fin du document
Set MonSignetRange = Selection.Range
MonSignetNom = "DocRefEnCours"
.Bookmarks.Add Name:=MonSignetNom, Range:=MonSignetRange
Selection.EndKey Unit:=wdStory 'Pour aller à la fin du document
Selection.Range.InsertParagraphAfter ' et ajouter un retour chariot pour que la souris sorte du paragraphe
End With
Set MonSignetRange = Nothing
End Sub
Function AjouterTexteSignet(ByVal DocSource, ByVal DocEnCours, ByVal MonSignet As Bookmark, ByVal TexteSignet As String)
'Pour que le texte soit dans le "range" du signet
Dim intI As Long 'Le début su Signet
Dim MonSignetNom As String 'Le nom du Signet
Dim MonSignetRange As Range 'Le range du Signet
'Dim TexteSignet As String 'Placé en variable public
'Copier le texte du signet DocRefSource vers le signet DocRefEnCours
With DocSource
TexteSignet = .Bookmarks("DocRefSource").Range.Text
With DocEnCours
MonSignetNom = MonSignet.Name 'Récupération du nom du signet
intI = MonSignet.Start 'Récupération de la position de départ de notre signet
MonSignet.Range.Text = TexteSignet 'Affectation du Texte au Signet
'Affecter l'objet Range, avec une position de départ identique à celle du Signet
' et une position de fin correspondant à celle du début augmentée de la longueur du texte
Set MonSignetRange = DocEnCours8.Range(Start:=intI, End:=intI + Len(TexteSignet))
DocEnCours.Bookmarks.Add MonSignetNom, MonSignetRange ' Création du Bookmark sur l'objet Range
End With
End With
Set MonSignetRange = Nothing
AjouterTexteSignet = True 'Affecte la valeur True à la fonction
End Function
Sub CreerStyleSignet(ByVal DocEnCours As Document)
' créer un style de titre, à utiliser ulterieurement pour la mise en forme du texte du signet DocRefEnCours
Dim MonStyle As Style
Dim CtrI As Integer
On Error GoTo Fin
With DocEnCours
For CtrI = 1 To .Styles.Count
If .Styles(CtrI).NameLocal = "StyleTitreSignet" Then
'MsgBox "Ce style existe déjà !", vbCritical
GoTo Fin
End If
Next CtrI
Set MonStyle = .Styles.Add("StyleTitreSignet", 2)
With MonStyle.Font
.Bold = True
.Italic = False
.ColorIndex = wdBlack
.Name = "Arial"
.Size = 12
End With
End With
GoTo Fin
Fin:
Set MonStyle = Nothing
End Sub
Sub SelectionnerChaqueLigneDUnSignet(ByVal DocEnCours As Document, ByVal MonSignet As Bookmark, ByVal StyleAAppliquer As Style)
'Pour appliquer le style aux lignes selectionnées
Dim SignetEncours As Bookmark
With DocEnCours
For Each SignetEncours In .Bookmarks
If SignetEncours = MonSignet Then
If MonSignet.Range.Paragraphs.Count > 3 Then
With MonSignet.Range
.Paragraphs(1).Range.Style = StyleAAppliquer
.Paragraphs(4).Range.Style = StyleAAppliquer
End With
End If
End If
Next SignetEncours
End With
End Sub
Sub
'Pour appeler les procédures
AjouterLesSignets DocEnCours
AjouterTexteSignet DocSource, DocEnCours, DocEnCours.Bookmarks("DocRefEnCours"), TexteSignet
CreerStyleSignet DocEnCours
SelectionnerChaqueLigneDUnSignet DocEnCours, DocEnCours.Bookmarks("DocRefEnCours"), DocEnCours.Styles("StyleTitreSignet")
End sub |
VBA Word - Copier texte et police dans 1 signet - Copier une table d'un doc word à la fin d'un autre
Répondre avec citation
Envoyé par Marino69
!
Partager