fusion cellule identique sous World 2007

[camzo]

Bonsoir à tous,

J'utilisais une macro sympa sous World 2003 pour fusionner les cellules identiques d'une même colonne. Ca marchat très bien mais sous 2007, problème !

Voici mon code :

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
Sub fusion()
Dim plign, nbl, n As Long
Dim cref As Byte
Dim ref, refs  As Variant
'1ère ligne de données du tableau
plign = 1
'N° de la colonne contenant la référence client (à modifier éventuellement)
cref = 1
 
 
 
'Déterminer la dernière ligne du tableau
nbl = 100
 
'Modifier les 7 "adretour" avec vos adresses réelles
Testval:
If plign > nbl Then
GoTo Fin
End If
 
ActiveDocument.Tables(1).Cell(plign, cref).Select
ref = Selection
plign = plign + 1
ActiveDocument.Tables(1).Cell(plign, cref).Select
refs = Selection
If ref = refs Then
ActiveDocument.Tables(1).Cell(plign, cref).Select
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cells.Merge
GoTo Testval
Else
GoTo Testval
End If
 
Fin:
If ActiveDocument.Saved = False Then ActiveDocument.Save
 
End Sub

et j'ai comme message d'erreur :

erreur d'exécution 5941
le membre de la collection requis n'existe pas

avec pour ligne qui beugue :

Code :

ActiveDocument.Tables(1).Cell(plign, cref).Select

si quelqu'un a une idée, qu'il ne se gêne pas !!!

[irreantum]

Code :

ActiveDocument.Tables(1).Cell(plign, cref).Select

si quelqu'un a une idée, qu'il ne se gêne pas !!![/QUOTE]


Je n'ai pas encore office 2007 pour verrifier mais j'imagine que le code d'erreur que tu as rencontré t'indique que le tableau N° 1 n'existe pas. Peut être que sous word 2007 les tableaux sont numéroté en commençant pas 0

ton code deviendrait donc :

Code :

ActiveDocument.Tables(0).Cell(plign, cref).Select

Si c n'ai pas le cas, ce sont peut être les cellules des tableau qui ont changé de numérotation ...

bon c juste une suggestion, en passant ... Bonne contunuation !

[camzo]

merci mais ça ne marche pas...

j'ai vraiment du mal à voir ce qui cloche. J'ai obtenu un peu d'aide et voici ce que j'ai pu obtenir :

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
Sub fusion()
Dim plign, nbl, n As Long
Dim cref As Byte
Dim ref, refs  As Variant
'1ère ligne de données du tableau
plign = 1
'N° de la colonne contenant la référence client (à modifier éventuellement)
cref = 3
 
 
 
'Déterminer la dernière ligne du tableau
nbl = 100
 
'Modifier les 7 "adretour" avec vos adresses réelles
Testval:
If plign > nbl Then
GoTo Fin
End If
 
Set LaCell = ActiveDocument.Tables(1).Cell(plign, cref)
' LaCell.Select
ref = Selection
 
MsgBox (ref)
 
plign = plign + 1
ActiveDocument.Tables(1).Cell(plign, cref).Select
refs = Selection
If ref = refs Then
' ActiveDocument.Tables(1).Cell(plign, cref).Select
Set innutile = RecupCelLignePrecedente(ActiveDocument.Tables(1), plign, cref)
 
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cells.Merge
GoTo Testval
Else
GoTo Testval
End If
 
Fin:
If ActiveDocument.Saved = False Then ActiveDocument.Save
 
End Sub

mais, ça ne marche pas non plus...

peut-être que cela peut inspirer certains...

merci d'y jeter un coup d'oeil si certains ont le temps.


camzo

[Heureux-oli]

C'est pas cette ligne qui pose problème, j'ai utilisé la même mais en remplaçant les références par des valeurs et ça passe.

Essaie de définir les référence en long au lieu de byte.
J'ai peu d'espoir mais essaie quand même.

[Heureux-oli]

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
 
Sub fusion()
Dim plign, nbl, n As Long
Dim cref As Long
Dim ref, refs  As Variant
'1ère ligne de données du tableau
plign = 1
'N° de la colonne contenant la référence client (à modifier éventuellement)
cref = 1
'MsgBox ActiveDocument.Tables(1).Rows.Count
'MsgBox ActiveDocument.Tables(1).Columns.Count
 
 
 
 
'Déterminer la dernière ligne du tableau
nbl = 100
Debug.Print "1"
 
'Modifier les 7 "adretour" avec vos adresses réelles
Testval:
If plign > nbl Then
GoTo Fin
End If
Debug.Print "2"
 
ActiveDocument.Tables(1).Cell(plign, cref).Select
ref = Selection
Debug.Print "2.2", plign, cref
 
plign = plign + 1
ActiveDocument.Tables(1).Cell(plign, cref).Select
refs = Selection
If ref = refs Then
ActiveDocument.Tables(1).Cell(plign, cref).Select
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cells.Merge
plign = plign + 1
 
GoTo Testval
Else
GoTo Testval
End If
 
Fin:
If ActiveDocument.Saved = False Then ActiveDocument.Save
 
End Sub

J'ai toujours le même message d'erreur, mais cette fois il va au bout du tableau.