Salut,


Voilà un code qui permet d'effectuer la rotation du contenu d'une table.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 TournerTable()
'déclaration des variables
Dim intL As Integer, intC As Integer
Dim intI As Integer, intJ As Integer
Dim otbl1 As Table, otbl2 As Table
Dim intPostbl As Integer
If Selection.Information(wdWithInTable) Then
MsgBox "Le curseur doit se trouver derrière la table à traiter !"
Exit Sub
End If
'Récupération de la position de la table
Selection.HomeKey unit:=wdStory, Extend:=wdExtend
intPostbl = Selection.Tables.Count
'Affectation de la table
Set otbl1 = ActiveDocument.Tables(intPostbl)
'Affectation des valeurs de lignes et de colonnes
intL = otbl1.Rows.Count
intC = otbl1.Columns.Count
'création de la nouvelle table
Selection.Collapse direction:=wdCollapseEnd
'Selection.EndKey unit:=wdTable, Extend:=wdMove
Selection.InsertParagraphAfter
Set otbl2 = Selection.Tables.Add(Range:=Selection.Range, numrows:=intC, numcolumns:=intL)
For intI = 1 To intC
    For intJ = 1 To intL
    otbl2.Cell(intI, otbl1.Rows.Count + 1 - intJ).Range.Text = NetText(otbl1.Cell(intJ, intI).Range.Text)
    Next intJ
Next intI
otbl2.Select
Selection.Orientation = wdTextOrientationDownward
otbl2.AutoFitBehavior (wdAutoFitContent)
 
 
End Sub
Function NetText(stTemp As String) As String
NetText = Left(stTemp, Len(stTemp) - 2)
 
End Function
Le curseur de la souris doit impérativement se trouver juste derrière la table que l'on souhaite "tourner".
Il ne peut y avoir de cellules fusionnées dans la table de départ !