Exportar tabela para Word

Pessoal, boa tarde.

Estou passando por uma dificuldade, estou fazendo um sistema que após o preenchimentos dos campos pelo usuário, gera um documento em Word e PDF.

Preciso que uma tabela sai no documento gerado e não estou obtendo sucesso, será que alguém consegue identificar o problema no meu código?

Vamos lá, o modo que estou fazendo até o momento é o seguinte:

1ª - Exporto as informações que preciso para uma tabela no excel, tenho uma macro no excel que cola a tabela em um indicador salvo no meu Word.

Código:

Sub PreencheTabela()

 'Name of the existing Word doc.
    Const stWordReport As String = "Template_Aditivo.docm"

    'Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdbmRange As Word.Range

    'Excel objects.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnReport As Range

    'Initialize the Excel objects.
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("SEL_Report")
    Set rnReport = wsSheet.Range("Tabela1")

    'Initialize the Word objets.
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\PastaTemporaria - diogo.mattos" & "\" & stWordReport)
'    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
    Set wdbmRange = wdDoc.Bookmarks("Teste_Tabela").Range
    
    'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
'    On Error Resume Next
'    With wdDoc.InlineShapes(1)
'        .Select
'        .Delete
'    End With
'    On Error GoTo 0

    'Turn off screen updating.
    Application.ScreenUpdating = False
    'Copy the report to the clipboard.
    rnReport.Copy

    'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
    With wdbmRange
        .Select
        .Paste
        .Font.Size = 8
        .Font.Name = "Calibri"
    End With

    'Save and close the Word doc.
    'With wdDoc
    '    .Save
    '    .Close
    'End With

    'Quit Word.
    'wdApp.Quit

'++++++++++++++++++++++++++++++++++++++++++++++++

    'Null out your variables.
    'Set wdbmRange = Nothing
    'Set wdDoc = Nothing
    'Set wdApp = Nothing

    'Clear out the clipboard, and turn screen updating back on.
    'With Application
    '    .CutCopyMode = False
    '    .ScreenUpdating = True
    'End With

'+++++++++++++++++++++++++++++++++++++++++++++++++++

    'MsgBox "The report has successfully been " & vbNewLine & _
           "transferred to " & stWordReport, vbInformation

    
End Sub

2º - No meu Access, tenho o módulo abaixo que chama essa macro do excel e faz todos os outros preenchimentos no Word:

Código:

Public Function GeraDocumento()
Dim Nome_Arquivo As String
Dim msg As String

On Error GoTo TrataErro
'Define o nome que será salvo o Word
Nome_Arquivo = "Numero da proposta" & " - " & [Forms]![frm_principal]![Empreendimento] & " - " & [Forms]![frm_Clientes]![Cliente1] & " - " & [Forms]![frm_principal]![Num_Aditivo]
TrataErro:
    If Err.Number = 94 Then
        msg = MsgBox("Não foi especificado o nome do arquivo na aba de ""Condições Gerais""", vbInformation, "Atenção")
        Exit Function
    Else
    End If

'verifica se já existe um arquivo com o nome especificado na pasta output
'If Len(Dir(CurrentProject.Path & "\Output\" & Nome_Arquivo & ".docx", vbDirectory)) = 0 Then
            'abre os formulario com as mensagens da etapa
            DoCmd.OpenForm "frm_geração"
            
            'abre o formulario de fiadores para pegar as informações de preenchimento
            DoCmd.OpenForm "frm_Clientes"
            Forms!frm_Clientes.Visible = False
            DoCmd.OpenForm "frm_Fiadores"
            Forms!frm_Fiadores.Visible = False
            
            'chama o módulo que cria a pasta e baixa o template
            Call abrirtemplate
                
            '========================================
            '---------INÍCIO: GERA O TERMO-----------
            
            Dim wdApl As Object
            Dim strLocal As String
            Set wdApl = CreateObject("Word.Application")
            Dim FicheiroPDF As String
                      
            'Abre o template
            'wdApl.Documents.Open FileName:=CurrentProject.Path & "\Template_Aditivo.docm" ',passwordDocument:="SenhaDoDocumento"
            wdApl.Documents.Open FileName:=CurrentProject.Path & "\PastaTemporaria - " & UsuarioRede() & "\Template_Aditivo.docm", ReadOnly:=True ',passwordDocument:="SenhaDoDocumento"
                
                With wdApl
                            
     Dim xlsApp As Excel.Application
Dim wbBook As Excel.Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
Set wbBook = Workbooks.Open(CurrentProject.Path & "\SEL_Report.xlsm")
Set xlsApp = wbBook.Parent

wdApl.Visible = False
                            
       xlsApp.Run "PreencheTabela"
    
xlsApp.Application.Quit
    
    '.ActiveDocument.Bookmarks("Teste_Tabela").Select: .PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
                                                       Placement:=wdInLine, DisplayAsIcon:=False
                
                
                
                'Posiciona o cursor no INDICADOR e preenche com os dados do formulário
                .ActiveDocument.Bookmarks("Num_Aditivo").Select: .Selection.Text = Nz([Forms]![frm_principal]![Num_Aditivo])
                .ActiveDocument.Bookmarks("Num_Aditivo_Final").Select: .Selection.Text = Nz([Forms]![frm_principal]![Num_Aditivo_Final])
                .ActiveDocument.Bookmarks("Cliente").Select: .Selection.Text = Nz([Forms]![frm_principal]![Clientes])
                .ActiveDocument.Bookmarks("Fiador1").Select: .Selection.Text = Nz([Forms]![frm_principal]![Fiadores])
                .ActiveDocument.Bookmarks("Hipotecante").Select: .Selection.Text = Nz([Forms]![frm_principal]![Hipotecante])
                .ActiveDocument.Bookmarks("Contrato").Select: .Selection.Text = Nz([Forms]![frm_principal]![QdResumo_contrato])
                .ActiveDocument.Bookmarks("Garantias").Select: .Selection.Text = Nz([Forms]![frm_principal]![Garantias])
                .ActiveDocument.Bookmarks("Prazos_Financiamento").Select: .Selection.Text = Nz([Forms]![frm_principal]![prazos_aditivo])
                .ActiveDocument.Bookmarks("Taxa_Anual").Select: .Selection.Text = Nz([Forms]![frm_principal]![Taxa_Anual])
                .ActiveDocument.Bookmarks("Taxa_Mensal").Select: .Selection.Text = Nz([Forms]![frm_principal]![Taxa_Mensal])
                .ActiveDocument.Bookmarks("Taxa_Efetiva_Anual").Select: .Selection.Text = Nz([Forms]![frm_principal]![Taxa_Efetiva_Anual])
                .ActiveDocument.Bookmarks("Prazos_aditivo").Select: .Selection.Text = Nz([Forms]![frm_principal]![Prazo_aditivo])
                .ActiveDocument.Bookmarks("Valor_Tarifa_Aditamento").Select: .Selection.Text = Nz([Forms]![frm_principal]![Valor_Tarifa_Aditamento])
                .ActiveDocument.Bookmarks("Do_Contrato").Select: .Selection.Text = Nz([Forms]![frm_principal]![Cláusulas_Aditivos])
                wdApl.Selection.Range.Font.Bold = False
                wdApl.Selection.Range.Font.Underline = False
                .ActiveDocument.Bookmarks("Condições_Gerais").Select: .Selection.Text = Nz([Forms]![frm_principal]![CONDIÇÕES])
                .ActiveDocument.Bookmarks("Data").Select: .Selection.Text = Nz(Format([Forms]![frm_principal]![Data_Assinatura], "dd") & " de " & Format(Now(), "Mmmm") & " de " & Format(Now(), "yyyy"))
                .ActiveDocument.Bookmarks("Ass_Credor").Select: .Selection.Text = Nz([Forms]![frm_principal]![Ass_Cliente])
                '.ActiveDocument.Bookmarks("Ass_Hipotecante").Select: .Selection.Text = Nz([Forms]![frm_principal]![Ass_Hipotecante])
                .ActiveDocument.Bookmarks("Ass_Fiador").Select: .Selection.Text = Nz([Forms]![frm_principal]![Ass_Fiador])
                wdApl.Selection.Range.Font.Bold = False
                wdApl.Selection.Range.Font.Underline = False
                                                  
            '===============INICIA NEGRITO CLIENTE/HIPOTECANTE E FIADORES================
            '----------------------------------------------------------------------------
                With wdApl.Selection.Find
                .ClearFormatting
                If [Forms]![frm_Clientes]![Cliente1] <> "" Then
                .Text = [Forms]![frm_Clientes]![Cliente1] & ","
                .Replacement.Font.Bold = True
                .Replacement.Font.Italic = False
                .Replacement.Font.Underline = False
                .Replacement.Text = [Forms]![frm_Clientes]![Cliente1] & ","
                .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
                End If
                
                If [Forms]![frm_Clientes]![Cliente2] <> "" Then
                .Text = [Forms]![frm_Clientes]![Cliente2] & ","
                .Replacement.Font.Bold = True
                .Replacement.Font.Italic = False
                .Replacement.Font.Underline = False
                .Replacement.Text = [Forms]![frm_Clientes]![Cliente2] & ","
                .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
                End If
                
                If [Forms]![frm_Clientes]![Cliente3] <> "" Then
                .Text = [Forms]![frm_Clientes]![Cliente3] & ","
                .Replacement.Font.Bold = True
                .Replacement.Font.Italic = False
                .Replacement.Font.Underline = False
                .Replacement.Text = [Forms]![frm_Clientes]![Cliente3] & ","
                .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
                End If
                
                If [Forms]![frm_Fiadores]![Fiador1] <> "" Then
                .Text = [Forms]![frm_Fiadores]![Fiador1] & ","
                .Replacement.Font.Bold = True
                .Replacement.Font.Italic = False
                .Replacement.Font.Underline = False
                .Replacement.Text = [Forms]![frm_Fiadores]![Fiador1] & ","
                .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
                End If
                
                End With
            '===============INICIA NEGRITO CLIENTE/HIPOTECANTE E FIADORES================
            '----------------------------------------------------------------------------
                
                
            'mensagens da etapas de confecção do documento
            Forms.frm_geração.msg1.Visible = False
            Forms.frm_geração.msg2.Visible = True
            Forms.frm_geração.Caixa719.Visible = True
                                  
            'chama a macro no word que coloca os negritos
            wdApl.Run "Negritos"
            
            'chama a macro no word que coloca os negritos
            wdApl.Run "numeracaoclausulas"
                                  
            'Define o local que será salvo o Word
            strLocal = CurrentProject.Path & "\Output\" & Nome_Arquivo & ".docx"
            'Salva o Word - Se não quiser salvar o word, basta comentar ou excluir essa linha
            .ActiveDocument.SaveAs strLocal, FileFormat:=wdFormatDocumentDefault ' , Password:="123"
            
            Set wdApl = .ActiveDocument
            
            'mensagens da etapas de confecção do documento
            Forms.frm_geração.msg2.Visible = False
            Forms.frm_geração.msg3.Visible = True
            Forms.frm_geração.Caixa720.Visible = True
            
            
            'Define o local e nome que será salvo o PDF
            FicheiroPDF = CurrentProject.Path & "\Output\" & Nome_Arquivo & ".pdf"
            'Código para salvar o PDF
            wdApl.ExportAsFixedFormat OutputFileName:=FicheiroPDF, ExportFormat:= _
            wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
            Item:=wdExportDocumentContent, IncludeDocProps:=True
                                              
            'Fecha o documento
            .ActiveDocument.Close
            'Fecha o Word
            wdApl.Quit
            End With
            'Limpa a memória
            Set wdApl = Nothing
            
            '---------FIM: GERA O TERMO-----------
            '========================================
            
            'mensagens da etapas de confecção do documento
            Forms.frm_geração.msg3.Visible = False
            Forms.frm_geração.msg4.Visible = True
            Forms.frm_geração.Caixa721.Visible = True
            Forms.frm_geração.btFechar.Visible = True
            
            'Fecha o fomulario de fiadores
            DoCmd.Close acForm, "frm_Fiadores"
            DoCmd.Close acForm, "frm_Clientes"
            
            'apaga todos os ficheiros da pasta temporaria
              Kill CurrentProject.Path & "\PastaTemporaria - " & UsuarioRede() & "\" & "*.docm"
            'depois apaga a pasta temporaria
              RmDir CurrentProject.Path & "\PastaTemporaria - " & UsuarioRede() & "\"

'Else
'    msg = MsgBox("Já existe um arquivo salvo com esse nome." & vbCrLf & vbCrLf & "Verificar na pasta ""\Output\"" se trata-se de uma duplicidade ou " _
    & "altere o nome do arquivo na aba de " & """Condições Gerais""!", vbExclamation + vbOKOnly + vbDefaultButton2, "Atenção!")
'End If

End Function

Aqui está o meu problema, se rodo a macro do excel na mão, ela funciona perfeitamente.
Quando chamo a macro pelo Access, ele gera o documento do Word normalmente, mas acontece que a tabela não está salva.


Se alguém souber algum outro modo mais fácil, seria melhor ainda!!!


Alguém consegue me ajudar?

Desde já, agradeço!