Word [VBA] Scinder Tableau Saut de Page

[Staple1600]

Bonsoir le forum

Une petite question sur laquelle je sèche.
Sur un document Word formaté comme suit
Quelques lignes de texte à partir du haut de la page
puis un tableau avec N lignes
Avec le code suivant, j'arrive à insérer un saut de page entre chaque ligne du tableau

Sub Insere_Saut()
Dim rw As Word.Row
With ActiveDocument.Tables(1)
  Set rw = .Rows(2)
  While Not rw Is Nothing
    If Len(rw.Cells(1).Range.Text) > 1 Then
      rw.Range.InsertBreak Type:=wdPageBreak
    End If
    Set rw = rw.Next
  Wend
End With
End Sub

• Le blocage se situe sur le point suivant.

Je cherche à qu'apparaisse sur chaque nouvelle feuille, les lignes de texte qu'il y avait en haut du document
(NB: il ne s'agit pas du contenu de l'entête - il n'y en a pas)
Pour tester , j'ai procéder comme suit (sur un document Word vierge)
1) Saisir =lorem(3,3) puis ENTER
2) Exécuter la macro ci-dessous

Sub CreationExemple()
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=5, NumColumns:=5
With Selection.Tables(1)
  .Borders.InsideLineStyle = 1: .Borders.OutsideLineStyle = 1
  .Cell(1, 1).Range.Text = "123": .Cell(2, 1).Range.Text = "456"
  .Cell(3, 1).Range.Text = "789": .Cell(4, 1).Range.Text = "ABC"
  .Cell(5, 1).Range.Text = "EFG"
End With
End Sub

3) Lancer la macro Insere_Saut

Le but recherché est donc de reproduire le texte* qu'il y a au départ sur chaque nouvelle page .
*: texte à positionner avant la ligne de tableau qui figure sur chaque feuille.

 

[Staple1600]

Bonjour le fil

[Petit UP+7]
.LOG
8/11/19 19:34
9/11/19 15:46
10/11/19 09:40
11/11/19 11:59
13/11/19 00:55
14/11/19 19:27
15/11/19 19:17
[/Petit UP+7]

 

[patricktoulon]

re
perso excel et word je suis pas le meilleur
une question
ne faut il pas convertir ta table de x lignes en x table de 1 lignes afin de les insérer après insertion de la copie du texte en titre

en tout je serais étonné que l'on puisse scinder une table en y mettant des fields (texte) entre deux lignes de table ( ca ne serait plus une table )
je dis ça mais je ne connais pas le contexte peut être dis je une bêtise

pourrait on avoir un exemple de ce .doc afin que je me fasse les dents dessus

 

[Staple1600]

Bonjour le fil, patricktoulon

=>patricktoulon
Le contexte;
Un document Word généré par un applicatif tiers
Document qui commence par un paragraphe ( coordonnées intitulé du doc, date , phrase introductive etc...)
suivi d'un tableau de N lignes qui se répartit sur N pages lors de la génération de l'applicatif.
Le but recherché est d'avoir un document word avec N pages
sur lesquelles figureront:
page1
le paragraphe
suivi d'un tableau d'une ligne ( la ligne 1 du grand tableau initial)
page2
le paragraphe
suivi d'un tableau d'une ligne ( la ligne 2 du grand tableau initial)
page3
le paragraphe
suivi d'un tableau d'une ligne ( la ligne 3 du grand tableau initial)
page N
le paragraphe
suivi d'un tableau d'une ligne ( la ligne N du grand tableau initial)
etc...

 

[Staple1600]

Re

Je mets une macro pour créer un exemple plus complet
(avec un exemple de début du document suivi d'un grand tableau)

Sub Création_Exemple()
Application.ScreenUpdating = False
ENTETE_DOC_EXEMPLE
EXEMPLE_TABLEAU
End Sub

Sub ENTETE_DOC_EXEMPLE()
  With Selection
    .TypeText Text:="RAISON SOCIALE EXPEDITEUR"
    .ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(10.25), Alignment:=0, Leader:=0
    .TypeText Text:=vbTab & "Ville, le "
    .InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField:=True, DateLanguage:=1036, CalendarType:=0, InsertAsFullWidth:=False
    .TypeParagraph: .TypeText Text:="ADRESSE 1"
    .TypeParagraph: .TypeText Text:="ADRESSE 2"
    .TypeParagraph: .TypeText Text:="CP VILLE"
    .TypeParagraph: .TypeText Text:="TITRE DU DOCUMENT"
    .TypeParagraph: .TypeParagraph: .TypeParagraph
  End With
  With ActiveDocument.Paragraphs(5)
    .Alignment = 1: .Range.Bold = True
    .Range.Font.Size = 14: .Range.Borders(1).LineStyle = 7
  End With
End Sub
Sub EXEMPLE_TABLEAU()
Dim objTable As Table, i As Long
Set objTable = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=120, NumColumns:=4)
objTable.Borders.InsideLineStyle = 1
objTable.Borders.OutsideLineStyle = 1
Randomize
With objTable
    For i = 1 To objTable.Rows.Count
      .Cell(i, 1).Range.Text = i
      .Cell(i, 2).Range.Text = Chr(Int((90 - 65 + 1) * Rnd + 65)) & "|" & Right(Application.Build, 4) + i
      .Cell(i, 3).Range.Text = Chr(Int((57 - 48 + 1) * Rnd + 48)) & "|" & Application.UserName
      .Cell(i, 4).Range.Text = Application.Language + i
    Next i
End With
End Sub

 

[Staple1600]

Re

Donc sur cet exemple si je lance la macro du message#1 Insere_Saut
Le tableau est bien éclaté sur N page
(avec une ligne par page)
Mais la page commence directement par une ligne de tableau.
J'aimerais donc pouvoir insérer un paragraphe avant chaque ligne
(pour ensuite pouvoir y coller le bloc texte du la première page et ce sur chaque nouvelle page)

 

[patricktoulon]

re
bonjour Staple1600
je sais
j'ai même tenté d'insérer un paragraphe a partir d'excel avant la table et il s’insère toujours après

il n'y a pas une histoire de signet a placer

edit je viens d'essayer a la main dans word et je ne pense pas que ce soit possible ca mélange tout

je pense que comme je l'ai dis plus haut il faut réécrire le document
addparagraphe +add table ligne1
addparagraphe + add table ligne2
etc.....

 

[Staple1600]

Bonjour le fil, patricktoulon, tatiak

Merci d'être passé dans ce fil
Merci pour vos suggestions et propositions
En testant le code de tatiak, cela m'a ouvert les chakras
J'ai enfin pu insérer un paragraphe avant la ligne de tableau (et non pas dans la ligne du tableau)

Sub Insere_Saut_II()
Dim rw As Word.Row
Application.ScreenUpdating = False
With ActiveDocument.Tables(1)
  Set rw = .Rows(2)
  While Not rw Is Nothing
    If Len(rw.Cells(1).Range.Text) > 1 Then
      'If rw.Range.Information(wdActiveEndPageNumber) > Page Then
      '.Rows.Add beforerow:=rw 'insére une ligne vide au dessus - Pas OK
      'rw.Range.InsertParagraphBefore '-> insère un paragraphe dans la 1ère cellule - Pas OK
      rw.Range.InsertBreak Type:=wdPageBreak
      rw.Range.InsertBreak Type:=wdColumnBreak '-> Bingo !!!!
    End If
    Set rw = rw.Next
  Wend
End With
End Sub

Reste le souci de "recopier" dans ce nouveau paragraphe (et ce sur chaque feuille), le bloc de texte de la première page initiale (avant l'éclatement du tableau)
Et dans l'idéal, ce serait de faire la chose dans la même boucle.

 

[Hasco]

Re bonjour l'ami,

Je te propose pour insérer les hauts de page en même temps que les sauts:

Sub Insere_Saut_II()
    Dim rngToCopy As Range
    Dim rw As Word.Row
    Application.ScreenUpdating = False
   
    With ActiveDocument
        Set rngToCopy = .Range(.Paragraphs(1).Range.Start, .Paragraphs(5).Range.End)
        rngToCopy.Copy
        With .Tables(1)
            Set rw = .Rows(2)
            While Not rw Is Nothing
                If Len(rw.Cells(1).Range.Text) > 1 Then
                    rw.Range.InsertBreak Type:=wdPageBreak
                    rw.Range.InsertBreak Type:=wdColumnBreak    '-> Bingo !!!!
                     ' Déplacement de la sélection sur la page venant d'être créée
                    Selection.GoTo wdGoToPage, which:=wdGoToNext, Name:=rw.Range.Information(wdActiveEndPageNumber)
                     ' réduire la sélection au point d'insertion puis coller
                    Selection.Range.Collapse
                    Selection.Range.Paste
                End If
                Set rw = rw.Next
            Wend
        End With
    End With
End Sub

P.S. j'ai réduis le nombre de lignes du tableau à 5 pour les tests. Si ça marche sur 5 , ça devrait marcher sur 120

A+++

 

[Staple1600]

Re, Bonjour Roblochon

Si ça marche sur 5 , ça devrait marcher sur 120

Ici, cela ne marche que pour 2 et après ça part en vrille.
Caramaba! Ouch!
J'investigue mais point ne trouve où le bât blesse

PS: J'ai testé ton code sur un document vierge où j'ai au préalable exécuté le code du message#5

 

[Staple1600]

Bonsoir le fil

Merci à tous.
Grâce à vos interventions et mes cogitations, je suis arrivé à ce résultat fonctionnel.
(mais en deux passes)

Sub Traitement()
Application.ScreenUpdating = False
m_A
m_B
End Sub
Sub m_A()
Dim rw As Word.Row
With ActiveDocument.Tables(1)
  Set rw = .Rows(2)
  While Not rw Is Nothing
    If Len(rw.Cells(1).Range.Text) > 1 Then
      rw.Range.InsertBreak Type:=wdPageBreak
      rw.Range.InsertBreak Type:=wdColumnBreak
    End If
    Set rw = rw.Next
  Wend
End With
End Sub
Sub m_B()
Dim i&, Rng As Range, Rng2 As Range
With ActiveDocument
    Set Rng2 = .Range(.Paragraphs(1).Range.Start, .Paragraphs(5).Range.End)
        For i = 2 To .ComputeStatistics(wdStatisticPages)
          Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
          Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
              With Rng
                .Collapse wdCollapseStart
                .FormattedText = Rng2
              End With
        Next
    End With
End Sub

PS: Est-ce vous voyez une autre voie (qui n'utiliserait qu'une seule macro et une seule boucle) ?

 

[Staple1600]

Bonsoir le fil,

Suite de mes aventures dans le VBA de Word
Voila une version en une passe
Est-ce que vous voyez un moyen d’accélérer la chose ?

Sub All_In_One()
Dim oWrd As Word.Document, oPg As Range, Rng2 As Range, rw As Word.Row
Application.ScreenUpdating = False
Set oWrd = ActiveDocument
On Error Resume Next
With oWrd
  Set Rng2 = .Range(.Paragraphs(1).Range.Start, .Paragraphs(5).Range.End)
End With
  With oWrd.Tables(1)
    Set rw = .Rows(2)
    While Not rw Is Nothing
        rw.Range.InsertBreak Type:=wdPageBreak
        rw.Range.InsertBreak Type:=wdColumnBreak
        Set oPg = oWrd.GoTo(wdGoToPage, which:=wdGoToNext, Name:=rw.Range.Information(3))
        With oPg
          .Collapse wdCollapseStart
          .FormattedText = Rng2
        End With
      Set rw = rw.Next
    Wend
  End With
End Sub

 

[Staple1600]

Bonsoir le fil

Personne pour un coup d'accélérateur?
(cf question dans précédent message)