Copier cellule d'excel et la copier dans word

Version imprimable

10/10/2019, 15h10
xavion

Copier cellule d'excel et la copier dans word
Bonjour je lutte depuis un moment pour faire marche un copier/coller entre excel et word. Le code marchait sous Office 2011 mais plus sous 2016.
Le copy marche mais j'arrive pas à coller et j'ai tout essayé enfin je pense..
Je vous mets mon code
Code:

1 2 3 4 5 Sheets("Base").Range("D" & RowQuestion + 1).Copy c.Activate c.Bookmarks("Document" & k).Select Selection.PasteExcelTable False, False, False
c est la ligne suivante :

Code:

Set c = wObj.Documents.Open(LResult & "Vierge_Ecrit_LQ.doc")

Merci à tous par avance,

Xav
10/10/2019, 16h06
Invité

Citation:

Envoyé par xavion

Bonjour,

Dans votre ligne

Code:

Selection.PasteExcelTable False, False, False

Selection doit être un objet Word.Selection et il vous faut instancier une variable de ce type.
10/10/2019, 17h19
xavion

Bonjour et merci Eric,

je vous avoue que je ne comprends pas la variable. Vous pouvez développer?

Merci d'avance,

Citation:

Envoyé par Eric KERGRESSE

Bonjour,

Dans votre ligne

Code:

Selection.PasteExcelTable False, False, False

Selection doit être un objet Word.Selection et il vous faut instancier une variable de ce type.

Citation:

Envoyé par xavion

Code:

1
2
3
4
5
6
7
 
Dim MaSelection As Object  ' ou  Word.Selection
 
    Set C = wObj.Documents.Open(LResult & "Vierge_Ecrit_LQ.doc")
    Set MaSelection = wObj.Selection
    C.Bookmarks("Document" & k).Select
    MaSelection.PasteExcelTable False, False, False

24/10/2019, 14h53
xavion

Bonjour et merci pour votre réponse mais ça bloque à la commande "paste" (ligne 7). Le programme boucle. L'information est bel et bien copiée depuis excel et quand je fais un coller manuel je retrouve bien ce que je veux coller mais cela ne marche pas dans word.
24/10/2019, 17h48
Invité

Citation:

Envoyé par xavion

Bonjour,

Mettez en ligne votre document pour voir.
25/10/2019, 14h10
xavion

Citation:

Envoyé par Eric KERGRESSE

Bonjour,

Mettez en ligne votre document pour voir.

Bonjour et merci encore de m'aider. Le document est sensible car il s'agit d'une banque de données pour un examen. Je vais vous créer une version avec des réponses bidons du coup ça va prendre un peu de temps.
Merci
25/10/2019, 14h54
Invité

Citation:

Envoyé par xavion

Mais au fait, si vous copiez-collez plus d'une fois sur le même signet, êtes-vous certain que votre signet existe toujours le deuxième coup ?
27/10/2019, 17h28
xavion

3 pièce(s) jointe(s)

Citation:

Envoyé par Eric KERGRESSE

Mais au fait, si vous copiez-collez plus d'une fois sur le même signet, êtes-vous certain que votre signet existe toujours le deuxième coup ?

Bonsoir et merci encore pour votre aide. Vous comprendrez mieux quand vous aurez ouvert le code je pense. N'hésitez pas si vous avez des questions mais je ne colle pas sur le même signet en fait. Le code est fait maison aussi il n'est pas "pro" du tout.
Pièce jointe 513456 Pièce jointe 513458 Pièce jointe 513462

Citation:

Envoyé par xavion

En admettant que les noms des signets soient en colonne C et leur contenu en colonne D :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
Option Explicit
 
' Référencer la DLL Microsoft Word
 
Sub MajDoc()
 
Dim AireQuestions As Range
Dim I As Long
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim MaSelection As Word.Selection
 
 
    On Error GoTo Fin
 
    Application.ScreenUpdating = False
 
    With Sheets("Base")
         I = .Cells(.Rows.Count, "C").End(xlUp).Row
         Set AireQuestions = .Range("C2:C" & I)
    End With
 
    Set WordApp = CreateObject("word.application")
    With WordApp
         .Visible = True
         Set WordDoc = .Documents.Open("C:\Users\...) ' A adapter
         Set MaSelection = .Selection
    End With
 
    For I = 1 To AireQuestions.Count
        With WordDoc
             If .Bookmarks.Exists(AireQuestions(I).Value) Then
                .Bookmarks(AireQuestions(I).Value).Select
                With MaSelection
                     .EndKey unit:=5, Extend:=1
                     .Text = AireQuestions(I).Offset(0, 1).Value
                End With
             End If
        End With
    Next I
 
    GoTo Fin
 
 
Fin:
 
    WordDoc.Close savechanges:=wdSaveChanges
    WordApp.Quit
 
    Set MaSelection = Nothing
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Set AireQuestions = Nothing
 
    Application.ScreenUpdating = True
 
End Sub

28/10/2019, 12h55
xavion

Merci beaucoup Eric j'ai adapté et ça fonctionne bien.
Bonne journée,