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