(VBA Word]Naviguer dans un tableau word [Résolu]

[aA189]

Bonjour , je n'arrive pas à naviguer correctement dans mon tableau word .
Le prog fonctionne partiellement seulement .

Ci joint un fichier html a modifier sous word pour comprendre la formes des tableaux .

Code :

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
 
 
Sub ParcourirTableau()
 
Dim r As Integer, c As Integer
Dim indice As Integer
Dim tableau, NbreTableau As Table
 
Set tableau = ActiveDocument.Tables
 
indice = 1 
 
tableau = False
 
For Each tableau In ActiveDocument.Tables
 
ActiveDocument.Tables(indice).Cell(0, 0).Select
For r = 1 To ActiveDocument.Tables(indice).Rows.Count
For c = 1 To ActiveDocument.Tables(indice).Columns.Count
 
ActiveDocument.Tables(indice).Cell(r, c).Select ‘sur cette ligne un bug: "le membre de 'la collection requis n’existe pas" 
'En gros je pense que le prog ne comprend pas qu’une ligne du tableau n° 2  ne 'fasse qu'une seule cellule .Ca plante et ne passe pas à la ligne n°2 .
'A terme mon objectif est de récupérer l’avant dernière ligne de mon tableau n°4  'afin d’y insérer une (des) nouvelle(s) ligne(s) .Mais pour cela il faut je sache 'naviguer dans les coordonnées d’un tableau word .
 
Selection.TypeText text:=Str(r) & ", " & Str(c)
Next c
Next r
indice = indice + 1
 
Next tableau
 
 
End Sub

[SilkyRoad]

bonjour

tu peux tester cette adaptation

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub ParcourirTableau()
    Dim R As Integer, C As Integer
    Dim Tableau As Table
 
    'boucle sur la collection de tableau dans le document actif
    For Each Tableau In ActiveDocument.Tables
        'boucle sur les lignes de chaque tableau
        For R = 1 To Tableau.Rows.Count
            'boucle sur les colonnes de chaque tableau
            For C = 1 To Tableau.Columns.Count
            'insere les données dans chaque cellule
            Tableau.Cell(R, C).Range.Text = CStr(R) & ", " & CStr(C)
            Next C
        Next R
    Next Tableau
End Sub

bon week end
michel

[aA189]

Non , le problème reste le même : "Le membre de la collection requis n'existe pas"

Le fond du souci est que je ne comprend pas comment le tableau a été contruit .Il n'a pas été fait avec l'outil Word il y a de fortes chances ....

Il faudrait que je casse la struture de ce tableau et en refaire une autre adapté à Word mais comment ? ...

[SilkyRoad]

apparament tu as des sous tableaux dans certaines cellules :

à tester

Code :

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
Option Explicit
 
Dim Indx As Integer
 
Sub ParcourirTableau()
Dim aTab As Table
 
    For Each aTab In ActiveDocument.Tables
        BoucleTables aTab
    Next aTab
 
    Indx = 0
End Sub
 
 
Sub BoucleTables(Tableau As Table)
    Dim R As Integer, C As Integer
    Dim bTab As Table
 
        Indx = Indx + 1
 
        On Error Resume Next
        For R = 1 To Tableau.Rows.Count
            'boucle sur les colonnes de chaque tableau
            For C = 1 To Tableau.Columns.Count
                Tableau.Cell(R, C).Range.Text = _
                    Indx & ", " & CStr(R) & ", " & CStr(C)
            Next C
        Next R
 
 
        For Each bTab In Tableau.Tables
            BoucleTables bTab
        Next
End Sub

michel

[aA189]

Oui c'est ce qu'il me faut ainsi j'obtient les coordonnées de chaques cellules .Mais ...Ce n'est pas fini .
IL faut à présent que je mette un signet dans chaques sous tableaux voir chaques cellules (je crains de manquer de mémoire pour ce dernier cas) .Le hic est qu e si j'arrive à creer les bookmarks , je n'arrive pas à le simplanter dans les cellules parce que mon curseur ne bouge pas ...
Voici ou j'en suis ....

Code :

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
Option Explicit
 
Dim r As Integer, c As Integer
Dim Indx As Integer
 
 
Sub ParcourirTableau1()
Dim aTab As Table
 
    For Each aTab In ActiveDocument.Tables
        BoucleTables aTab
    Next aTab
 
 
 
    Indx = 0
End Sub
 
 
Sub BoucleTables(tableau As Table)
 
    Dim bTab As Table
 
        Indx = Indx + 1
 
        On Error Resume Next  
 
        For r = 1 To tableau.Rows.Count
            'boucle sur les colonnes de chaque tableau
            For c = 1 To tableau.Columns.Count
                tableau.Cell(r, c).Range.text = _
                    Indx & ", " & CStr(r) & ", " & CStr(c)
 
‘objectif mettre au moins un signet pour chaques sous tableaux
‘l’ideal serait un signet pour chaques cellules mais je crains des problèmes de mémoire
            If r = 1 And c = 1 Then 
              Marque  
            End If
 
            Next c
        Next r
 
 
        For Each bTab In tableau.Tables
            BoucleTables bTab
            'marque
        Next
 
End Sub
 
Sub marque()
 
Dim NomTableau, NbreTableau
'Set NomTableau = ActiveDocument.Tables
 
NomTableau = Array("Tableaux", "Dossier", "Epaisseurplancher", "Tableau4", _
"Tableau5", "Tableau6", "Tableau7", "Tableau8", "Tableau9", "Tableau10", _
"Tableau11", "Tableau12", "Tableau13", "Tableau14", "Tableau14", "Tableau16", _
"Tableau17", "Tableau18", "Tableau19", "Tableau20", "Tableau21", "Tableau22", _
"Tableau23", "Tableau24", "Tableau25", "Tableau26", "Tableau27", "Tableau28", _
"Tableau29", "Tableau30", "Tableau31", "Tableau32", "Tableau33", "Tableau34", _
"Tableau35", "Tableau36", "Tableau37")
 
 
 
With ActiveDocument.bookmarks
.Add Range:=tableau.Cell(r, c).Range, Name:=NomTableau(Indx) ‘ici ca plante je n’arrive pas à déplacer le curseur .Le paramètre tableau ne suit pas de la fonction BoucleTables vers la focntion marque
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
 
 
 
End Sub

[SilkyRoad]

bonjour

j'espere que cet exemple pourra t'aider

Code :

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
Option Explicit
 
Dim Indx As Integer
Dim NomTableau
 
 
Sub ParcourirTableau()
Dim aTab As Table
 
NomTableau = Array("Tableaux", "Dossier", "Epaisseurplancher", "Tableau4", _
"Tableau5", "Tableau6", "Tableau7", "Tableau8", "Tableau9", "Tableau10", _
"Tableau11", "Tableau12", "Tableau13", "Tableau14", "Tableau14", "Tableau16", _
"Tableau17", "Tableau18", "Tableau19", "Tableau20", "Tableau21", "Tableau22", _
"Tableau23", "Tableau24", "Tableau25", "Tableau26", "Tableau27", "Tableau28", _
"Tableau29", "Tableau30", "Tableau31", "Tableau32", "Tableau33", "Tableau34", _
"Tableau35", "Tableau36", "Tableau37")
 
    For Each aTab In ActiveDocument.Tables
        BoucleTables aTab
    Next aTab
 
    Indx = 0
End Sub
 
 
Sub BoucleTables(Tableau As Table)
    Dim R As Integer, C As Integer
    Dim bTab As Table
 
        On Error Resume Next
        For R = 1 To Tableau.Rows.Count
            'boucle sur les colonnes de chaque tableau
            For C = 1 To Tableau.Columns.Count
 
                'Ajout signets
                With ActiveDocument.Bookmarks
                    .Add Range:=Tableau.Cell(R, C).Range, _
                        Name:=NomTableau(Indx) & "_" & R & "_" & C
                    .DefaultSorting = wdSortByName
                    .ShowHidden = False
                End With
 
            Next C
        Next R
 
        Indx = Indx + 1
 
        For Each bTab In Tableau.Tables
            BoucleTables bTab
        Next
End Sub

michel

[aA189]

Avec ça en remodelant un peu je devrais arriver à mes fins sous peu .Et puis a force de bidouiller mon projet je commence à être un peu out nerveusement ...Du style

Un grand merci à SilkyRoad de m'éviter d'avoir la cervelle encore plus bugguée .