VBA copier tableau excel vers Word

mikaconny

XLDnaute Nouveau
Bonjour, je cherche un moyen sur Excel en VBA, Avec de préférence un "CommandButton", pour copier une plage de cellule ou un tableau, à ouvrir un fichier Word vierge et à coller ma sélection... J'ai cherché sur le net mais en vain. Merci d'avance de votre aide...
 

tatiak

XLDnaute Barbatruc
Re : VBA copier tableau excel vers Word

Bonjour,
A minima, on peut écrire un truc du genre (ici pour copier la zone A1:C6 de la feuille courante) :
Code:
Sub Creer_Word()
Dim WordApp As Object, WordDoc As Object, NDF As String

    ActiveSheet.Range("A1:C6").Copy
    On Error Resume Next
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Visible = True
        Set WordDoc = .documents.Add
        .Selection.typetext Text:="Titre du document"
        .Selection.Paste
    End With
   
    NDF = ActiveWorkbook.Path & "\Document_" & Format(Now(), "yyyymmdd_hhmm")
    WordDoc.Application.ActiveDocument.SaveAs NDF
    Set WordDoc = Nothing
    Set WordApp = Nothing
    MsgBox ("Traitement OK")
End Sub
Pierre
 

tatiak

XLDnaute Barbatruc
Re : VBA copier tableau excel vers Word

Re
Si on a besoin de plus de souplesse qu'un simple copier/coller, on peut créer le tableau comme suit :
Code:
Sub Creer_Word2()
Dim WordApp As Object, WordDoc As Object, NDF As String
Dim i As Integer, j As Integer

    On Error Resume Next
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Visible = True
        Set WordDoc = .Documents.Add
        .Selection.typetext Text:="Titre du document"

        WordDoc.Tables.Add Range:=.Selection.Range, NumRows:=6, NumColumns:=3
        For i = 1 To 6
            For j = 1 To 3
                With WordDoc.Tables(1)
                    .Cell(i, j).Range.InsertAfter ActiveSheet.Cells(i, j).Value
                End With
            Next j
        Next i
    End With
   
    NDF = ActiveWorkbook.Path & "\Document_" & Format(Now(), "yyyymmdd_hhmm")
    WordDoc.Application.ActiveDocument.SaveAs NDF
    Set WordDoc = Nothing
    Set WordApp = Nothing
    MsgBox ("Traitement OK")
End Sub
Pierre
 

Discussions similaires


Haut Bas