Discussion :

[Guiggs]

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 :

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