Discussion :

[Montail31]

Bonjour,

j'ai un document modèle avec des champs de fusion.
Dans ce document je rentre du texte que j'aimerai copier dans un autre endroit du même document.
J'ai essayé avec les signets et renvois, mais ils disparaissent à chaque réouverture du document.
J'ai essayé les copier coller en VBA mais je cale, limité par mes connaissances surement.

Je joint le document avec en partie rouge les parties de doc à copier.

Merci de votre aideTest document.docxTest document.docx

[Montail31]

En précision, il faut dire que le texte n'est pas toujours le même, et qu'il change à chaque fois, et que j'aimerai remplir l'autre partie de mon document en automatique via VBA.
j'ai pensé à faire un copier du texte situé entre tel mot et tel mot et le copier entre tel mot et tel mot. Mais je ne sais pas comment faire.

merci de votre aide

Bonjour,

j'ai un document modèle avec des champs de fusion.
Dans ce document je rentre du texte que j'aimerai copier dans un autre endroit du même document.
J'ai essayé avec les signets et renvois, mais ils disparaissent à chaque réouverture du document.
J'ai essayé les copier coller en VBA mais je cale, limité par mes connaissances surement.

Je joint le document avec en partie rouge les parties de doc à copier.

Merci de votre aideTest document.docxTest document.docx

[E KERGRESSE]

Bonjour,

Si vous remplacez le contenu des signets, il y a de fortes chances qu'ils n'existent plus après modification, il faut les reconstruire en sélectionnant les nouveaux textes.

Dans l'exemple ci-dessous, on saisit les contenus des signets 1, 2, 3 dans un userform et la validation met à jour les signets et leur renvoi.



La mise à jour des renvois doit être réalisée selon leur position dans le document (directement dans un paragraphe ou dans une forme).

Le code dans un module standard :

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
 
Option Explicit
 
Public ContenuSignet1 As String, ContenuSignet2 As String, ContenuSignet3 As String
Public Continuer As Boolean
 
Sub MettreAJourLesSignets()
 
    Continuer = False
    With UsfSignets
         .TextBoxSignet1 = ActiveDocument.Bookmarks("Texte1").Range.Text
         .TextBoxSignet2 = ActiveDocument.Bookmarks("Texte2").Range.Text
         .TextBoxSignet3 = ActiveDocument.Bookmarks("Texte3").Range.Text
         .Show
    End With
 
    If Continuer = False Then Exit Sub
 
    MajSignet ActiveDocument, "Texte1", ContenuSignet1
    MajSignet ActiveDocument, "Texte2", ContenuSignet2
    MajSignet ActiveDocument, "Texte3", ContenuSignet3
 
    MettreAJourLesRenvois
 
End Sub
 
 
Sub MajSignet(ByVal DocEnCours As Document, ByVal NomDuSignet As String, ByVal ContenuDuSignet As String)
 
    DocEnCours.Bookmarks(NomDuSignet).Select
    With Selection
         .Range.Text = ContenuDuSignet
         .Expand Unit:=wdParagraph
         .Bookmarks.Add Name:=NomDuSignet
         .MoveRight Unit:=16
         .TypeParagraph
    End With
 
End Sub
 
 
Sub MettreAJourLesRenvois()
 
Dim WdDoC As Document
Dim I As Integer
 
    Set WdDoC = ActiveDocument
    With WdDoC
 
         .Range.Fields.Update  ' Renvoi Textes 2 et 3
 
         For I = 1 To .Shapes.Count
             With .Shapes(I).TextFrame
                  If .HasText Then
                     If .TextRange.Fields.Count > 0 Then .TextRange.Fields.Update  ' Renvoi Texte1
                  End If
             End With
         Next I
 
    End With
    Set WdDoC = Nothing
 
End Sub

Le code dans l'userform :

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
Option Explicit
 
Private Sub BoutonRetour_Click()
 
        Continuer = False
        Unload UsfSignets
 
End Sub
 
Private Sub BoutonValider_Click()
 
 
       ContenuSignet1 = Me.TextBoxSignet1
       ContenuSignet2 = Me.TextBoxSignet2
       ContenuSignet3 = Me.TextBoxSignet3
 
       Continuer = True
       Unload UsfSignets
 
End Sub

[Montail31]

Merci beaucoup pour la réponse, mais j'ai trop de texte à mettre, et je ne serai pas le seul à utiliser le document.

Je pensais plutôt à un copier coller automatique. Copier le texte entre 2 Mots puis coller dans un document à la suite .

Ou tout autre méthode.

[Montail31]

J'ai essayé en faisant des copier coller en VBA mais ça ne marche pas, je ne sais pas pourquoi.Test document.docxTest document.docxTest document.docxTest document.docxTest document.docx

[Montail31]

J'ai fait quelques lignes pour copier et coller du texte. Voir ci dessous.

J'aimerai lors du copier coller que les balises soient supprimées. Pour le moment ça me supprime que les balises de fin.

Voici mon code :

Private Sub CommandButton1_Click()
Dim doc As Document
Set doc = ActiveDocument

' Copier le texte entre "sommaire de l'établissement" et "conception des bâtiments"
CopierCollerEntreBalises doc, "Copier début descriptif", "Copier fin descriptif", _
"Coller début descriptif", "Coller fin descriptif"

' Copier le texte entre "proposition d'avis du groupe" et "prescriptions"
CopierCollerEntreBalises doc, "Copier début avis", "Copier fin analyse", _
"Coller début avis", "Coller fin analyse"

' Copier le texte entre "ci-après" et "règlement en vigueur"
CopierCollerEntreBalises doc, "Copier début prescriptions", "Copier fin prescriptions", _
"Coller début prescriptions", "Coller fin prescriptions"




End Sub

Sub CopierCollerEntreBalises(doc As Document, debutBalise As String, finBalise As String, _
debutCollerBalise As String, finCollerBalise As String)
' Déclaration des variables
Dim debutRange As Range
Dim finRange As Range
Dim texteCopie As Range

' Sélection du texte entre les balises
Set debutRange = doc.Range
debutRange.Find.Text = debutBalise
debutRange.Find.Execute
Set finRange = doc.Range
finRange.Find.Text = finBalise
finRange.Find.Execute

' Copier le texte entre les balises
Set texteCopie = doc.Range(debutRange.End, finRange.Start)
texteCopie.Copy

' Coller le texte entre les balises de collage
debutRange.Find.Text = debutCollerBalise
debutRange.Find.Execute
Set finRange = doc.Range
finRange.Find.Text = finCollerBalise
finRange.Find.Execute
finRange.Paste

End Sub