[XL-365] Copie de cellules Excel vers un document Word

Bonjour,

J'ai créé une macro me permettant de copier des cellules Excel vers un document Word.
Cependant, j'ai souvent le message d'erreur cf pièce jointe sur la ligne où il y a les étoiles.

Voici ma macro :

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 copie_texte(selection_texte As String, largeur As Integer, Optional Lignesrepet As Long = 0, Optional Hauteur As Double = 0)
Dim rngTemp, i As Long
    Range(selection_texte).Select
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    Selection.Copy
    With objWord
            If CountClipboardFormats <> 0 Then
            'si le presse papier n'est pas vide alors on copie
                .Selection.PasteAndFormat 16
                .Selection.Tables(1).PreferredWidthType = 2 ****** LIGNE SURLIGNÉE LORS DE L'ERREUR *******
                .Selection.Tables(1).PreferredWidth = largeur
                On Error Resume Next
                If Lignesrepet <> 0 Then
                    Set rngTemp = .Selection.Tables(1).Range
                    i = 1 + (Lignesrepet - 1) * rngTemp.Columns.Count
                    With rngTemp
                        .SetRange Start:=.Cells(1).Range.Start, End:=.Cells(i).Range.End
                        .Rows.HeadingFormat = True
                    End With
                    Set rngTemp = Nothing
                End If
                If Hauteur <> 0 Then
                    .Selection.Tables(1).Rows.Height = .CentimetersToPoints(Hauteur)
                End If
                vide_presse_papier
                On Error GoTo 0
                vide_presse_papier
            Else
                'le presse papier est videMsgBox "Erreur lors de la copie, le presse papier est saturé, merci de relancer la génération du rapport", vbExclamation, "Erreur presse papier"
                Application.ScreenUpdating = True
                Set DocWord = Nothing
                Set objWord = Nothing
                docExcel.Sheets("Menu Général").Activate
                End
            End If
    End With
End Sub

Pièce jointe 523417