VBA - Export to Word table

Bonjour à tous

Je viens vers vous car j'ai comme un petit bug de script....

J'aimerais exporter un tableau d'excel vers Word en utilisant la fonction "replacement", ce qui me permettrait de cibler dans le template l'endroit ou je voudrais qu'il soit collé.

Après plusieurs tentative je n'y suis pas arrivé.

Peut être que vous avez une idée. Il manque pas beaucoup juste le bon code de copie...

Voici le code:

Option Explicit
Dim WS_Gen As Worksheet
Dim Table, T1, T2, T3
Dim objWord As Word.Application
Dim docWord As Word.Document
Dim docWordF As Word.Document
Dim f As Range
Sub Word_Click()

    Set objWord = Nothing
    Set docWord = Nothing

Table = Sheets("Test").Range("B2:D5").Copy
T1 = Sheets("Test").Cells(8, 1).Value
T2 = Sheets("Test").Cells(8, 3).Value
T3 = Sheets("Test").Cells(8, 5).Value

    Dim Fichier As String

    'Optimize Code
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set objWord = CreateObject("Word.Application")
    Set docWord = objWord.Documents.Open(ThisWorkbook.Path & "\Table.doc")
    objWord.Visible = True
    objWord.Activate

    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "//t1//"
        .Replacement.Text = T1
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll

    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "//t2//"
        .Replacement.Text = T2
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll

    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "//t3//"
        .Replacement.Text = T3
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll

    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "//table//"
        .Replacement.Text = objWord.Selection.Paste
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Merci d'avance pour votre aide

Bonjour,

Tu ne précises pas l'endroit précis à partir duquel ta macro ne fonctionne pas ...

Oups

C'est lors de la copie du tableau soit "Table"

    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "//table//"
        .Replacement.Text = objWord.Selection.Paste
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll

et plus précisément avec cette ligne là

.Replacement.Text = objWord.Selection.Paste

Le paste ne passe pas :s

Re,

Je crois me souvenir que dans Word ...

1. PasteSpecial offre plus de souplesse ... que Paste ...

2. la localisation précise dans le document Word est un casse-tête qui est facilité par un bookmark ...

A tester ...

.Replacement.Text = objWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, _ 
            Placement:=wdInLine, DisplayAsIcon:=False

Oui c'est extact, c'est avec les signets de word que nous pouvons facilement placé les objets.

    ' Copie les données Excel
    ThisWorkbook.Worksheets("Feuil1").Range("I6:O19").Copy
    ' Colle les données dans Word
    objWord.Selection.Goto what:=wdGoToBookmark, Name:="Table1" ' on recherche le signet dans Word pour se positionner
    objWord.Selection.PasteSpecial link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False

J'ai trouvé ça qui marche nickel

Vous savez comment on peut rendre la copie du tableau selon le nombre de ligne avec LastRow ?

Re,

Content que cela fonctionne ...

Que signifie " rendre la copie du tableau " ...???

Oui c'est déjà ça

Faire évoluer la zone de copie selon le nombre de ligne trouvé avec la fonction "LastRow"

Re,

Si je comprends bien la question est :

Comment insérer des lignes dans la table de Word pour qu'elle ait le même nombre de lignes que le tableau Excel ...???

Est-ce bien cela ...???

Oui

J'ai trouvé

    'detérmine la dernière ligne pour x = 1 ou supérieur à 1
    LastRow = Columns("X").Find(1, SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole).Row
    i = LastRow
    Range("A1" & ":G" & i).Select
    Selection.Copy
    ' Colle les données dans Word
    objWord.Selection.Goto what:=wdGoToBookmark, Name:="Table2" ' on recherche le signet dans Word pour se positionner
    objWord.Selection.PasteSpecial link:=False, DataType:=1, Placement:=xlMove, DisplayAsIcon:=False

Merci à tous

Bonjour,

Content que tu aies trouvé la solution ... et Merci de l'avoir partagé avec le Forum ...