Exportando um intervalo para uma tabela em um documento de Word

Este exemplo usa o intervalo A1:A10 na Planilha 1 e o exporta para a primeira tabela em um documento Word existente chamado "Relatório de Tabela".

Código de exemplo fornecido por: Dennis Wallentin, VSTO & .NET & Excel

Sub Export_Table_Data_Word()

    'Name of the existing Word document
    Const stWordDocument As String = "Table Report.docx"
    
    'Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdCell As Word.Cell
    
    'Excel objects
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    'Count used in a FOR loop to fill the Word table.
    Dim lnCountItems As Long
    
    'Variant to hold the data to be exported.
    Dim vaData As Variant
    
    'Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")
    vaData = wsSheet.Range("A1:A10").Value
    
    'Instantiate Word and open the "Table Reports" document.
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
    
    lnCountItems = 1
    
    'Place the data from the variant into the table in the Word doc.
    For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
        wdCell.Range.Text = vaData(lnCountItems, 1)
        lnCountItems = lnCountItems + 1
    Next wdCell
    
    'Save and close the Word doc.
    With wdDoc
        .Save
        .Close
    End With
    
    wdApp.Quit
    
    'Null out the variables.
    Set wdCell = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    MsgBox "The " & stWordDocument & "'s table has successfully " & vbNewLine & _
           "been updated!", vbInformation

End Sub

Sobre o colaborador

Dennis Wallentin é o autor do VSTO & .NET & Excel, um blog que se concentra em soluções .NET Framework para Excel e Serviços do Excel. Dennis vem desenvolvendo soluções Excel há mais de 20 anos e também é coautor de "Desenvolvimento do Excel Profissional: O Guia Definitivo para o Desenvolvimento de Aplicativos Usando o Microsoft Excel, VBA e .NET (2ª Edição)".

Suporte e comentários

Tem dúvidas ou quer enviar comentários sobre o VBA para Office ou sobre esta documentação? Confira Suporte e comentários sobre o VBA para Office a fim de obter orientação sobre as maneiras pelas quais você pode receber suporte e fornecer comentários.