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
lideal 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 narrive 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 |
Partager