Imprimer/word/vba/tableau Résolu

Question

Bonsoir à tous

Je vous expose mon problème. J'ai un tableau sur word.Le nombre de colonnes est déterminé. Le nombre de lignes est variable. Je cherche à fractionner mon tableau en plusieurs tableaux. Chacun des nouveaux tableaux doit avoir le même en-tête, celui de départ. Sur excel, pas de problème avec les filtres.
J'utilise le code suivant. Il s'applique à un tableau exemple de 35 lignes. Je cherche à obtenir 7 tableaux (7 parce qu'il y  a 7 groupes) qui ne comptent pas nécessairement le nombre de lignes. Ainsi mon 1er tableau compte 6 lignes, mon second tableau compte 10 lignes. Ce nombre comprend l'en-tête.Connaîtriez-vous exceptée, un passage par excel (copier/coller), une méthode plus simple qui me permet d'aboutir au même résultat?
En effet, je dois repérer les groupes qui m'intéressent et corriger manuellemnt mon code ce qui n'est pas pratique.En effet, dans mon exemple, j'ai un tableau de 35 lignes mais je peux avoir un tableau initial de 250 lignes,mon 1er tableau peut avoir 42 lignes et avoir non pas 7 tableaux mais 3.
 Je précise mais les instructions n'apparaîssent pas ici que je cherche ensuite à imprimer ces  tableaux séparément (7 pour mon exemple).
Rows(1) représente la ligne d'en-tête.

Sub FractionnerTableau()
Set objTable = ActiveDocument.Tables(1)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(7).Select
       Selection.Paste
    objTable.Rows(7).Select
    Selection.SplitTable
'Fractionner après la 6eme ligne
'J'ai ainsi un 1er tableau de 6 lignes
End If
Set objTable = ActiveDocument.Tables(2)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(11).Select 
    Selection.Paste
    objTable.Rows(11).Select
    Selection.SplitTable
'J'ai un second tableau,etc...
End If
Set objTable = ActiveDocument.Tables(3)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(5).Select
      Selection.Paste
    objTable.Rows(5).Select
    Selection.SplitTable
End If
Set objTable = ActiveDocument.Tables(4)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(12).Select
       Selection.Paste
    objTable.Rows(12).Select
    Selection.SplitTable
End If
Set objTable = ActiveDocument.Tables(5)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(3).Select
       Selection.Paste
    objTable.Rows(3).Select
    Selection.SplitTable
End If
Set objTable = ActiveDocument.Tables(6)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(8).Select
          Selection.Paste
    objTable.Rows(8).Select
    Selection.SplitTable
End If
Set objTable = ActiveDocument.Tables(7)
If objTable.Rows.Count > 2 Then
    objTable.Rows(1).Select
    Selection.Copy
    objTable.Rows(3).Select
     Selection.Paste
    objTable.Rows(3).Select
    Selection.SplitTable
End If
End Sub

En espérant avoir été clair, je vous souhaite une bonne fin de soirée et une bonne reprise.

cs_bipou · Accepted Answer

bonjour

si tu préféres, tu peux remplacer par :

Sub FractionnerTableau()
dim colonne_rep as integer  'n° colonne qui sert au fractionnement
colonne_rep=5 'si c'est la 5eme colonne, sinon tu changes
Dim objtable, ligne_total As Integer, ligne As Integer, rep As Range, rep0 As Range
...

cs_bipou · Answer

bonjour,

tu peux essayer ceci : en deux partie : d'abord on récupère la liste des fractionnement puis on fractionne.

Sub FractionnerTableau(colonne_rep) ' fonction du n° colonne qui sert au fractionnement
Dim objtable, ligne_total As Integer, ligne As Integer, rep As Range, rep0 As Range
Dim liste_rupture As String, tab_rupture As Variant, i As Integer
Set objtable = ActiveDocument.Tables(1)
ligne_total = objtable.Rows.Count
If ligne_total > 2 Then
    objtable.Sort ExcludeHeader:=True, FieldNumber:=colonne_rep
    ligne = 2
    Set rep0 = objtable.Cell(ligne, colonne_rep).Range
    Do
        ligne = ligne + 1
        Set rep = objtable.Cell(ligne, colonne_rep).Range
        If rep <> rep0 Then
            liste_rupture = liste_rupture & ligne & ","
            Set rep0 = rep
        End If
    Loop Until ligne > ligne_total
    tab_rupture = Split(liste_rupture, ",")
For i = UBound(tab_rupture) - 1 To LBound(tab_rupture) Step -1
    objtable.Rows(1).Select
    Selection.Copy
    objtable.Rows(tab_rupture(i)).Select
    Selection.Paste
    objtable.Rows(tab_rupture(i)).Select
    Selection.SplitTable
Next
End If
Set objtable = Nothing
End Sub

cs_ZANUS · Answer

Bonsoir


Merci d'avoir répondu. Excuses moi (je ne suis pas un pro de VBA) mais
je ne comprends pas trop ta syntaxe. En particulier, je n'arrive pas à
lancer la macro (dans Outils/Macro/Macros, je ne la retrouve pas).
Impossible d'utiliser le pas à pas détaillé: je n'ai pas de message
d'erreur et la procédure ne se déroule pas.Je suppose qu'il faut faire
une manipulation du type choisir un n° de colonne mais comment.


Merci encore

cs_ZANUS · Answer

Merci beaucoup. Ça marche avec juste un petit détail pour ceux qui
seraient intéressés. La 1ère  ligne (je ne parle parle pas de la
ligne d'en-tête) se retrouve en dernier. Mais ce n'est pas grave
puisqu'il y a bien la ligne d'en-tête. J'ai donc bien autant de
tableaux avec en-tête que de groupes.


@+

Imprimer/word/vba/tableau

4 réponses

Votre réponse

Discussions similaires