Discussion :

[payadz2024]

bonjour à tous
j'essaye d écrire une macro simple qui lit un fichier texte et qui l’insère après le paragraphe contenant:"Coller après cette ligne" puis qui remet le point d'insertion au début de "Coller après cette ligne".
Simple, mais ca marche pas!
le code a l'air cohérent:

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
Sub aaa_coller()
    Dim searchRange As Range
    Dim clipboardData As DataObject
    Dim Rep_DossiersTemp As String
 
    ' Définir la zone de recherche sur tout le document
    Set searchRange = ActiveDocument.Content
 
    ' Rechercher le paragraphe contenant "Coller après cette ligne"
    With searchRange.Find
        .Text = "Coller après cette ligne"
        .Forward = True
        .Wrap = wdFindStop
        If .Execute Then
            ' Si trouvé, se positionner à la ligne suivante
            searchRange.Collapse Direction:=wdCollapseEnd
            searchRange.Move Unit:=wdParagraph, Count:=1
            searchRange.Collapse Direction:=wdCollapseStart
 
            ' Coller le contenu du fichier
            Rep_DossiersTemp = "C:\_cabinet\__Dossiers\~Additions_VBA~nv1\temp"
            InsererTexteLigneParLigne (Rep_DossiersTemp & "\" & "dtl_001.temp")
 
            ' Revenir à la ligne contenant "mon index"
            searchRange.Move Unit:=wdParagraph, Count:=-1
            searchRange.Select
        Else
            MsgBox "Texte 'Coller après cette ligne' non trouvé."
        End If
    End With
 
End Sub
 
Function InsererTexteLigneParLigne(filePath As String)
    Dim fileNum As Integer
    Dim line As String
 
    ' Ouvre le fichier texte en mode lecture
    fileNum = FreeFile
    Open filePath For Input As #fileNum
 
    ' Lit le fichier ligne par ligne et l'insère dans le document Word
    Do While Not EOF(fileNum)
        Line Input #fileNum, line  ' Lire une ligne
        Selection.TypeText line    ' Insérer la ligne dans le document
        Selection.TypeParagraph    ' Ajouter un saut de ligne
    Loop
 
    ' Fermer le fichier
    Close #fileNum
End Function

mais l'insertion se fait en haut du document
je n’arrive à voir si c'est la routine de recherche de "Coller après cette ligne" qui ne fonctionne ou pas
ou le déplacement de l'insertion après le repèrage ?
si quelqu'un a une idée...
PS nouveau compte, l'ancien (2017) ne fonctionne plus

[Nain porte koi]

Hello,

y'a plus simple

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
Sub bbb_coller()
    Dim Rep_DossiersTemp As String
 
    With Selection.Find
        .Text = "Coller après cette ligne"
        .Forward = True
        .Wrap = wdFindStop
        If .Execute Then
            ' Coller le contenu du fichier
            Rep_DossiersTemp = "C:\_cabinet\__Dossiers\~Additions_VBA~nv1\temp"
            Selection.InsertFile FileName:=Rep_DossiersTemp & "\dtl_001.temp"
        Else
            MsgBox "Texte ""Coller après cette ligne"" non trouvé."
        End If
    End With
 
End Sub

[payadz2024]

effectivement marche très bien en étant plus simple et merci
reste un problème, le texte inséré apparait en courrier 10.5 ce qui ne correspond à aucun de mes styles prédéfinis.
une idée pour lui redonner le format habituel de la page ? (pour moi 2023_r)

PS: le code que j'ai essayé provient de plusieurs essais avec chatGPT

[payadz2024]

pour le formattage de la page j'ai ça:

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
Sub SelectionnerPageAppliquerStyle()
    Dim doc As Document
    Dim rngPage As Range
    Dim pageDebut As Long, pageFin As Long
    Dim styleAppliquer As String
 
    ' Définir le nom du style
    styleAppliquer = "0023_rdv"
 
    ' Référence au document actif
    Set doc = ActiveDocument
 
    ' Définir la plage correspondant à la page actuelle
    pageDebut = Selection.Information(wdActiveEndPageNumber)
 
    ' Sélectionner la page actuelle
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageDebut
    Set rngPage = Selection.GoTo(What:=wdGoToBookmark, name:="\page")
 
    ' Appliquer le style à la page sélectionnée
    rngPage.Style = styleAppliquer
 
    ' Revenir au début de la page
    rngPage.Select
    Selection.Collapse Direction:=wdCollapseStart
End Sub

et ça ne marche pas !
en pas à pas on a bien la selection de toute la page, mais l'application du format de marche pas (et sans message d'erreur)
bizarre non ?
d'autant que si je le fais à la main ça marche!

[payadz2024]

j'ai trouvé comment appliquer les attributs d'un style (mais pas le style lui même):

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
Sub AppliquerStyleEtRevenirDebutPage()
    Dim doc As Document
    Dim rngPage As Range
    Dim pageDebut As Range
    Dim pageFin As Range
    Dim pageNum As Integer
 
    ' Référence au document actif
    Set doc = ActiveDocument
 
    ' Obtenir le numéro de la page actuelle
    pageNum = Selection.Information(wdActiveEndPageNumber)
 
    ' Définir la plage correspondant au début et à la fin de la page actuelle
    Set pageDebut = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageNum)
    Set pageFin = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageNum + 1)
 
    ' Ajuster la plage pour la page actuelle (exclure la fin de la page suivante)
    Set rngPage = doc.Range(pageDebut.Start, pageFin.Start - 1)
 
    ' Sélectionner la page
    rngPage.Select
 
    ' Appliquer le style "0023_rdv" à la page sélectionnée
'        Selection.Style = "0023_rdv"   'NMP 2024-09-26_11-35
'        Selection.Style = ActiveDocument.Styles("0023_rdv") 'NMP 2024-09-26_11-35
     With rngPage.Font
         .name = "Calibri"
         .Size = 7
        ' .Bold = True
     End With
    ' Revenir au début de la page
    pageDebut.Select
End Sub

ca fonctionne, mais c'est moche.
C'est sans doute possible d' intégrer la mise en forme au moment de l insertion du fichier, mais je n'y arrive pas

[Nain porte koi]

Hello,

effectivement c'est un problème cette insertion qui ne tient pas compte du style
Voici un nouveau code inspiré du premier

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
Sub ccc_coller()
 
    Dim Chemin_Fichier As String
    Dim Num_Fichier As Integer
    Dim Ligne_Texte As String
 
    Dim Zone_Recherche As Range
    Set Zone_Recherche = ActiveDocument.Content
 
    With Zone_Recherche.Find
        .Text = "Coller après cette ligne"
        .Forward = True
        .Wrap = wdFindStop
 
        If .Execute Then
 
            Zone_Recherche.Delete 'supprime le texte trouvé
 
            Chemin_Fichier = "C:\_cabinet\__Dossiers\~Additions_VBA~nv1\temp\dtl_001.temp"
 
            Num_Fichier = FreeFile
            Open Chemin_Fichier For Input As #Num_Fichier
            Do While Not EOF(Num_Fichier)
                Line Input #Num_Fichier, Ligne_Texte
                Zone_Recherche.InsertAfter Ligne_Texte
                Zone_Recherche.InsertParagraphAfter
                Zone_Recherche.Collapse Direction:=wdCollapseEnd
            Loop
            Close #Num_Fichier
 
        Else
            MsgBox "Texte ""Coller après cette ligne"" non trouvé."
        End If
    End With
End Sub