VBA pour modifier un tableau MS WORD de 11 cols à 6 cols

Question

J'ai un certain nombre de tableaux MS Word à 11 colonnes que je dois modifier.

Chaque document contiendra 1 tableau.

Je veux modifier un tableau de 11 cols à 6 cols.

VBA pour effectuer les tâches suivantes :

1. Renommez l'intitulé de la colonne 2 de "Time" en "Item".

2. Renommer l'intitulé de la col. 3 de Fuseau horaire à Commentaire

3. Renommer le titre de la colonne 5 de Type à E ou A

4. Supprimez tout le texte des colonnes 2, 3 et 5 (pas les titres renommés).

5. Supprimer les colonnes 6, 7, 9, 10, 11

J'ai indiqué l'ordre d'édition du tableau dans ce que je pense être le meilleur, mais cela n'a pas vraiment d'importance.

Je ne sais pas si le texte des colonnes 2, 3 et 5 peut être supprimé sans que les titres soient également supprimés.

Enfin, je suppose que je pourrais simplement saisir les nouveaux titres que je souhaite dans les colonnes 2, 3 et 5 si ces titres sont supprimés lorsque le texte de ces colonnes est supprimé.

Merci pour toute aide.

Answer 1

J'espère que cela vous aidera,

Option Explicit

Private Sub myTableMacro()
    Dim tmpTable As Word.Table, tmpRange As Word.Range
    With ActiveDocument
        If .Tables.Count > 0 Then
            For Each tmpTable In .Tables
                    'Rename col 2 heading from Time to Item
                tmpTable.Cell(1, 2).Range.Text = "Item"
                    'Rename col 3 heading from Time Zone to Comment
                tmpTable.Cell(1, 3).Range.Text = "Comment"
                    'Rename col 5 heading from Type to E or A
                tmpTable.Cell(1, 5).Range.Text = "E or A"
                    'Delete all text in cols 2, 3 (but not the headers)
                Set tmpRange = .Range(tmpTable.Cell(2, 2).Range.Start, tmpTable.Cell(tmpTable.Rows.Count, 3).Range.End)
                tmpRange.Select
                Selection.Delete Unit:=wdCharacter, Count:=1
                    'Delete all text in cols 5 (but not the headers)
                Set tmpRange = .Range(tmpTable.Cell(2, 5).Range.Start, tmpTable.Cell(tmpTable.Rows.Count, 5).Range.End)
                tmpRange.Select
                Selection.Delete Unit:=wdCharacter, Count:=1
                    'Delete cols 10, 11
                Set tmpRange = .Range(tmpTable.Cell(1, 9).Range.Start, tmpTable.Cell(1, 11).Range.End)
                tmpRange.Select
                Selection.Cells.Delete wdDeleteCellsEntireColumn
                    'Delete cols 6, 7, 9
                Set tmpRange = .Range(tmpTable.Cell(1, 6).Range.Start, tmpTable.Cell(1, 7).Range.End)
                tmpRange.Select
                Selection.Cells.Delete wdDeleteCellsEntireColumn
            Next 'tmpTable
        End If
    End With
    Set tmpRange = Nothing
    Set tmpTable = Nothing
End Sub

J'ai fait des tests et j'ai trouvé que tout allait bien.