1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
| Sub CopieTableauWord()
Dim Wd As Object, Doc As Object, I as Integer, Largeur as Single
Set Wd = GetObject(, "Word.Application")
Set Doc = Wd.activedocument
Set Var = Doc.tables(1)
Doc.tables(1).Range.Copy
Sheets("Feuil2").Select
[A1].Select
ActiveSheet.PasteSpecial Format:="HTML"
For i = 1 To Doc.tables(1).Columns.Count
largeur = Doc.tables(1).Columns(i).Width / [A1].Offset(, i - 1).EntireColumn.Width * _
[A1].Offset(, i - 1).EntireColumn.ColumnWidth
[A1].Offset(, i - 1).EntireColumn.ColumnWidth = largeur
Next i
End Sub |
Partager