[Resolvido] Referência Excel Objec t Library

Tenho um sistema que, entre outras funções, gera uma planilha Excel e está instalado em um HD externo.

Meu problema é que ele pode ser executado em computadores com versões diferentes de Office e tenho que ficar mudando a referência do Excel Object Library.

Existe alguma maneira de se fazer via programação ?

Veja esse exemplo que postei tempos atrás no Repositório. Ele exclui referências ausentes e possibilita a criação de novas referências à partir de um arquivo. Como as referências dos produtos MS são bibliotecas que estão em um caminho normalmente igual para todos os aplicativos e sendo diferenciados apenas pelo número da versão no nome da pasta aonde esses arquivos estão, acredito que conseguirás adaptar o exemplo para sua necessidade. No caso, você pode fazer uma verificação da versão do Office e se for diferente, quebra a versão atual e busca a nova versão.

Criquio,

estudei seu excelente código e estou me deparando com o seguinte problema :
Coloquei-o no evento Ao Abrir da minha tela inicial mas, quando abro a aplicação,
acusa erro de compilação causado pela ausência da referência , nem permitindo a execução do seu código .

Como pode-se resolver isso ?

Verifique as referências se tem alguma escrito AUSENTE. Se tiver, desmarque-a e tente novamente.

Criquio,

O meu objetivo era tornar desnecessária a intervenção manual. Para isso Montei o código na seguinte ordem :


1. Remover as referências ausentes
2. Ativar as novas referências

Pelo visto, não conseguirei remover as referências ausentes por código.

Com isso o meu objetivo não pode ser alcançado, certo ?

Não vi o código passado pelo Grande Criquio, mas tenho este que utilizo à algum tempo e sempre funcionou;

Se quiser testar, tamos ae...

Public Function RemoveReferenciasAusentes()
Dim ref As Variant

With Application.VBE.ActiveVBProject
    For Each ref In .References
        If ref.IsBroken Then
            .References.Remove ref
        End If
    Next
End With
End Function

Esse é exatamente o código do Criquio. Coloquei-o no inicio da macro Autoexec

O problema é, já acusa erro de sintaxe (causado pela referência que falta, na execução da macro.

Assim, nem consigo executar esse código

A solução é não usar a macro autoexec.

Nas configurações do seu banco coloque o form principal a abrir em primeiro lugar.

No evento vba do form, ao abrir você escreve,

On Error Resume Next

Depois chama a função,

Call RemoveReferenciasAusentes()

Entendi ! A parte de remoção das referências ausentes funciona perfeitamente.

Mas estou tentando adaptar o código para que o sistema automaticamente adicione a referência faltante do Excel.

Qual é a DLL que devo adicionar para Microsoft Excel Object Library ?

A pasta padrão dessa referência, quando o Office está na sua rota padrão é:
C:\Program Files\Microsoft Office\OfficeX\EXCEL.EXE

X significa a versão do Office. Você só precisa pegar o código de adicionar referências e passar a versão do Access nele:

Código:

Dim  myVersion As String

myVersion = "C:\Program Files\Microsoft Office\Office" & Int(Application.Version) & "\EXCEL.EXE"

Criquio e JPaulo

Obrigado pela paciência

Funcionou perfeitamente

Grato pelo retorno. O fórum agradece.

Sei que é antigo este post. Mas gostaria de saber como referenciar via código o Excel existente na maquina. Tipo. Meu Excel é 16, em outras máquinas são 11,12 e 13.

Haveria possibilidade de um código referenciar automaticamente o Excel existente na maquina?

Ola Claudio,

Leia com atencao o topico.
Na mensagem 6 tem o codigo para remover as referencias ausentes.
Na mensagem 8 como pode fazer a chamada
e na mensagem n. 10 como adicionar a referencia.

Abraco

Bom dia Teixeira.

Obrigado por suas dicas.
Claro que lí todo o tópico, senão não havia perguntado.

Repare que nem sempre quando temos a faca e o queijo na mãos significa que podemos comer... falta algo ás vezes...

Como expliquei anteriormente a versão que uso é a 2016, até ai tudo bem.

Só que o código de remoção das referências ocorre erro logo ao abrir o access e como a máquina só tem o runtime 2010, não consigo prever qual o erro.

Somente esta imagem informando a ausência da referência do Excel 2016 e não remove a referência ausente.

Quanto ao código para adicionar a referência não encontrei na mensagem 10 e aquela informação da mensagem 10 não está adicionando.

Será que falta algo?

Obrigado por sua grande ajuda.

Olá Claudio,

Tudo bem, talvez seja melhor partilhar pequeno exemplo (simples) de como tem a funcionar par se poder testar.

Abraço

Bom dia Teixeira.
Segue um exemplo da minha dúvida.

O form verifica_excel é o start do sistema, nele constam as dúvidas.

Deixei que ele abrisse outro form o 4-COTAÇÃO só para ilustrar o que preciso mesmo.

Na verdade como eu disse antes, tenho a versão 2016 do Excel, só que dependendo da máquina do Cliente existem versões 2010, 2013 e 2016.

Então seria viável que o sistema remova as referências ausentes (sem ocorre erro), verifique qual versão do Excel existe na máquina e registre esta versão como referência do usuário naquela máquina.

Eu consegui adaptar o sistema do Críquio, o problema é que teria que ir em cada máquina e referenciar o Excel um por um.
Fora que todas as vezes que houver atualizações terei de lembrar e ter que fazer isso.

Obrigado pela ajuda amigo.

Segue solução para adaptação
linhadecodigo.com.br/artigo/565/adicionando-referencias-dinamicamente-no-vba.aspx

Boa noite Damasceno. Obrigado por sua ajuda. Já havia visto este site. Juro que tentei fazer da forma que foi proposto. O problema é que tudo que tentei ocorre erro. Este site foi o mais próximo que cheguei a solução. Mas devido aos erros também não consegui.

Qual mensagem de erro ocorre?

Espero que esteja fazendo as adaptações para o Access, afinal, o código do artigo foi desenvolvido para o Excel (nota-se em ActiveWorkbook).

É esse ponto que não consegui chegar. Não manjo de códigos para Excel. Então apareceram vários erros. Acabei apagando tudo é começando do zero conforme o exemplo que lhe postei.

Damasceno bom dia.

Segue anexo exemplo baseado no link que me passou quais são os erros apresentados.

Já modifiquei por várias vezes, mas nada funciona.

Obrigado

Olá a todos,

Claudio, o caminho é como o colega sugeriu.
No seu ultimo ficheiro se compilar, verifica que falta a referencia a "Microsoft Visual Basic for Applications Extensibility 5.3", mas vai apresentar outros erros (código do excel)


Aproveito para informar que também temos a informação e solução na nossa casa desde 2011
https://www.maximoaccess.com/t3511-resolvidofalta-de-referencia
https://www.maximoaccess.com/t31450-resolvido-alterar-referencia-de-acordo-com-a-versao-do-office

Abraço a todos

Boa tarde.

Teixeira já havia visto estes 2 tópicos, sempre procuro aqui antes. Ok?

Agradeço muito a ajuda de vocês, mas como o tempo era curto acabei enfiando a cabeça e resolvi desta forma:

Tenho um form que utilizo para versionamento do sistema.
Quando clico em Gerar Versão ele efetua as funções que tenho e executa a função abaixo:

Código:


Public Sub RemoveReferenciaExcel()

Dim REF As Reference
For Each REF In References
    If REF.Name = "Excel" Then
        Application.References.Remove REF
        Exit For
    End If
Next

End Sub


Envio o arquivo compactado para o servidor e quando o usuário efetuar o login, o sistema registra a Referência do excel com o código abaixo:

Código:


Public Sub AdicionaReferenciaExcel()

Dim REF_2013 As Reference
Dim REF_2016 As Reference
   
'OFFICE 2013
'C:\Program Files\Microsoft Office 15\root\office15
'GUIDE: {00020813-0000-0000-C000-000000000046}
'MAJOR: 1
'MINOR: 8

'OFFICE 2016
'C:\Program Files\Microsoft Office\root\Office16
'GUIDE: {00020813-0000-0000-C000-000000000046}
'MAJOR: 1
'MINOR: 9

'Arquivo verifico se o excel está na pasta do usuário:
strPath = "C:\Program Files\Microsoft Office 15\root\office15\Excel.exe"

If Dir(strPath) = vbNullString Then
strCheck = False
'Se não existir ele referencia a linha abaixo
Set REF_2016 = References.AddFromFile("C:\Program Files\Microsoft Office\root\Office16\Excel.exe")
Else
strCheck = True
'Se existir ele referencia a linha abaixo
Set REF_2013 = References.AddFromFile("C:\Program Files\Microsoft Office 15\root\Office15\Excel.exe")
End If

End Sub


Sei que desta forma estou trabalhando somente com 2 versões, mas até aqui só encontrei estas 2 versões no cliente, caso encontre mais alguma vou referenciar de outro jeito.

Mas foi o jeito mais rápido e fácil que encontrei. Apesar de não ser ideal.

Obrigado a todos.

Parabéns pela evolução.

Obrigado. Não era exatamente o que queria. Mas por enquanto vai ficar assim até eu conseguir a forma correta que é verificar a versão da maquina e referenciar a versão dela.
Valeu.
Acho que não é difícil, mas esbarrei em soluções não muito bem explicadas. Pelo menos pra mim.

Exemplo para seu estudo e adaptação ao seu ambiente.

Nota: verifiquei que em um dos seus arquivos anexados no tópico você ora usa o método late binding (declarando o excel como objeto e depois instanciando com o createobject), ora usa o método early binding (usando a referência do excel e declarando o excel como excel.application). Todos os seus problemas seriam resolvidos usando o método late binding pois assim não precisaria descobrir a versão do excel na máquina do cliente.

Bom dia Damasceno.
Obrigado irmão.
Estou em viagem, mas assim que voltar vou ver este exemplo que tenho certeza será de grande valia.
Valeu pela força e obrigado por me ajudar.
Grande abraço

Bom dia Damasceno.

Fiz uns testes aqui e verifiquei que você têm razão em relação á não precisar declarar o excel e simplesmente trabalhar com o "late bindig".

Testei meu código sem declarar o excel e ele gera a primeira parte que é essa abaixo sem problemas e sem referência.

Código:


' EXPORTA COTAÇÃO PARA EXCEL

Public Function Exporta_Cotação()
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
On Error Resume Next

varId_cotação = CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"


' Rotina para verificar se o arquivo .xlsx está aberto.
    'If IsFileOpen(CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx") Then
    '    MsgBox "O Arquivo " & id_cotacao_gerada & ".xlsx" & " está aberto!" & vbCrLf & "Por favor, feche a Planilha." & vbCrLf & "O Sistema não pode Executar a Ação escolhida.", vbInformation, "Atenção"
    'Else

   
 'Rotina para excluir planilha gerada
        Kill CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"
   
Set oExcel = CreateObject("Excel.Application")

If Me.empresa = "ESTRELAÇO" Then
    Set oBook = oExcel.Workbooks.Open(Application.CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO_MODELO_ESTRELAÇO.xlsx")
    oExcel.visible = False
ElseIf Me.empresa = "KMV" Then
    Set oBook = oExcel.Workbooks.Open(Application.CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO_MODELO_KMV.xlsx")
End If

Set oSheet = oBook.Worksheets(1)

oSheet.Range("E4").Value = "REF.: " & Forms![4-COTAÇÃO]!referencia_interna
oSheet.Range("E5").Value = "DATA: " & Now
oSheet.Range("A8").Value = Forms![4-COTAÇÃO]!id_cotacao_gerada
oSheet.Range("C8").Value = Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]![txt_fornecedor]
oSheet.Range("C9").Value = "VENDEDOR: " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]![txt_vendedor] & " - " & Format(Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]![txt_telefone], "(00) 0000-0000") & " - " & Format(Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]![txt_celular], "(00) 00000-0000")

oBook.SaveAs CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"

oBook.Close
oExcel.Quit

DoCmd.SetWarnings False
DoCmd.OpenQuery "cns_Cotação_Excel_Itens_Exclui_Temp", acNormal, acEdit
DoCmd.SetWarnings True

Call filtra_listbox

Call ExportaItens_Cotação

'MsgBox "Cotação Exportada para o Excel com Sucesso!", vbInformation, "Informando"

Application.FollowHyperlink CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"

'End If

End Function


O problema está aqui neste código quando ele vai inserir os ítens ai ocorre o erro:

Código:


' EXPORTA ITENS DA COTAÇÃO
Public Function ExportaItens_Cotação()

'Variaveis do excel
Dim intLinha As Integer
Dim intColuna As Integer
Dim xl As New Excel.Application
Dim xlw As Excel.Workbook
Dim i As Integer
Dim N As Integer
Dim intcontador As Integer
Dim intContadorPag As Integer

Dim CaminhoPlanilha As String
On Error GoTo Fim

Dim Rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String

'Obtenho o caminho do carquivo
'----------------------------------------------------------------------
CaminhoPlanilha = CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"
   
    'Carrego o conjunto de registros
    Sel1 = "SELECT * from cotacao_sub_temp"
 
    Set Rst1 = CurrentDb.OpenRecordset(Sel1)
   
    If Me.empresa = "ESTRELAÇO" Then
        var_enviado_por_email = DLookup("email", "tblUsuários", "Autonumeração = " & Me.vendedor_id)
    ElseIf Me.empresa = "KMV" Then
        var_enviado_por_email = DLookup("email2", "tblUsuários", "Autonumeração = " & Me.vendedor_id)
    End If

    var_ddr_usuario = DLookup("Telefone_Direto", "tblUsuários", "Autonumeração = " & vendedor_id)


    'Inicio o contador da linha
    intLinha = 11
   
    'Abrir o arquivo do Excel
    Set xlw = xl.Workbooks.Open(CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx")
       
    'Aqui inicio o loop pelos registros da tabela
    Do While Not Rst1.EOF
    '--------------------------------------------------------------

        'Definimos qual será a planilha de trabalho
        xlw.Sheets("COTAÇÃO").Select

        'Envia o valor para cada celula (Linha, Coluna)
       
        xlw.Application.Cells(intLinha, 1).Value = Rst1![Item]
        xlw.Application.Cells(intLinha, 2).Value = Rst1![quant]
        xlw.Application.Cells(intLinha, 3).Value = Rst1![Unidade]
       
        xlw.Application.Cells(intLinha, 4).WrapText = True              'Quebra o texto
        xlw.Application.Cells(intLinha, 4).Rows.AutoFit                'Ajusta a altura
        xlw.Application.Cells(intLinha, 4).Value = Rst1![txt_produto]
       
        xlw.Application.Cells(intLinha, 5).Value = Rst1![codigo_ncm]
        xlw.Application.Cells(intLinha, 6).Value = "-"                  'ipi
        xlw.Application.Cells(intLinha, 7).Value = "-"                  'valor_unit
        xlw.Application.Cells(intLinha, 8).Value = "-"                  'valor_total
       
        'Chama a Função para desenhar as bordas da lista de Produtos
        Call BordasCelulaExcel(xlw, intLinha, 1, intLinha - 10)
        Call BordasCelulaExcel(xlw, intLinha, 2, Rst1![quant])
        Call BordasCelulaExcel(xlw, intLinha, 3, Rst1![Unidade])
        Call BordasCelulaExcel(xlw, intLinha, 4, Rst1![txt_produto])
        Call BordasCelulaExcel(xlw, intLinha, 5, Rst1![codigo_ncm])
        Call BordasCelulaExcel(xlw, intLinha, 6, " ")
        Call BordasCelulaExcel(xlw, intLinha, 7, " ")
        Call BordasCelulaExcel(xlw, intLinha, 8, " ")
       
        'Incremento o contador para mudar a linha
        intLinha = intLinha + 1
    '--------------------------------------------------------------
    Rst1.MoveNext
    Loop
   
    'Finalizo o loop
    Rst1.Close

    'Inicio a montagem do Rodapé após a lista de produtos
    With xlw.Application
    .Cells(intLinha + 1, 1).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 1, 1).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 1).Font.Bold = True                'Fonte em Nrgito
    .Cells(intLinha + 1, 1).Font.Size = 12                  'Tamanho da Fonte
    .Cells(intLinha + 1, 1).Value = "Nº ÍTENS: " & intLinha - 11
   
    .Cells(intLinha + 1, 7).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 1, 7).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 7).Font.Bold = True                'Fonte em Nrgito
    .Cells(intLinha + 1, 7).Font.Size = 12                  'Tamanho da Fonte
    .Cells(intLinha + 1, 7).Value = "TOTAL:"
   
    .Cells(intLinha + 3, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 3, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 3, 2).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 3, 2).Value = "Atenciosamente,"
   
    .Cells(intLinha + 4, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 4, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 4, 2).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 4, 2).Value = StrConv([vendedor_txt], 3)
   
    .Cells(intLinha + 5, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 5, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 5, 2).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 5, 2).Value = var_enviado_por_email
   
    .Cells(intLinha + 6, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 6, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 6, 2).Font.Size = 10                  'Tamanho da Fonte
    .Cells(intLinha + 6, 2).Value = Format([var_ddr_usuario], "(00) 0000-0000")

    End With
   
    'Para não salvar mude true para false
    xlw.Close True

    'Liberamos a memória
    Set xlw = Nothing
    Set xl = Nothing
'--------------------------------------------------------------

Exit Function

Fim:
    SysCmd 3
    MsgBox err.Number & " - " & err.Description
    Exit Function
End Function


Eu peguei este exemplo na internet, funciona corretamente, mas somente se referenciar o excel.

Obrigado pela ajuda amigo.

Veja, você continua usando excel.application (que precisa da referência marcada). Adapte e use objetos.

Public Function Exporta_Cotação()
Dim oExcel As Object <<<< Objetos
Dim oBook As Object <<<< Objetos
Dim oSheet As Object <<<< Objetos
On Error Resume Next
...

---------------------------------

' EXPORTA ITENS DA COTAÇÃO
Public Function ExportaItens_Cotação()

'Variaveis do excel
Dim intLinha As Integer
Dim intColuna As Integer
Dim xl As New Excel.Application <<<< Não objetos
Dim xlw As Excel.Workbook <<<< Não objetos
Dim i As Integer
Dim N As Integer
Dim intcontador As Integer
Dim intContadorPag As Integer
...

Bom dia.
Damasceno.

Refiz, mas não funciona, ocorre erros do mesmo jeito.
Tive que voltar tudo pra não perder o raciocínio.

Como falei antes, peguei este código na internet não fui eu quem desenvolveu, só adaptei a minha necessidade.

Efetuar alterações de códigos para excel, sou perdido nisso.

Mesmo assim obrigado pela ajuda.

Continuarei buscando soluções.

Veja. Modifiquei duas linhas e adicionei um terceira. Para sua evolução, estude o que foi feito.

Código:

' EXPORTA ITENS DA COTAÇÃO
Public Function ExportaItens_Cotação()

'Variaveis do excel
Dim intLinha As Integer
Dim intColuna As Integer
dim xl as object 'MODIFICADA
Dim xlw As Object 'MODIFICADA
Dim i As Integer
Dim N As Integer
Dim intcontador As Integer
Dim intContadorPag As Integer

Dim CaminhoPlanilha As String
On Error GoTo Fim

Dim Rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String

'Obtenho o caminho do carquivo
'----------------------------------------------------------------------
CaminhoPlanilha = CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"
   
    'Carrego o conjunto de registros
    Sel1 = "SELECT * from cotacao_sub_temp"
 
    Set Rst1 = CurrentDb.OpenRecordset(Sel1)
   
    If Me.empresa = "ESTRELAÇO" Then
        var_enviado_por_email = DLookup("email", "tblUsuários", "Autonumeração = " & Me.vendedor_id)
    ElseIf Me.empresa = "KMV" Then
        var_enviado_por_email = DLookup("email2", "tblUsuários", "Autonumeração = " & Me.vendedor_id)
    End If

    var_ddr_usuario = DLookup("Telefone_Direto", "tblUsuários", "Autonumeração = " & vendedor_id)


    'Inicio o contador da linha
    intLinha = 11
   
    'Abrir o arquivo do Excel
    set xl = CreateObject("Excel.Application") 'ADICIONADA
    Set xlw = xl.Workbooks.Open(CurrentProject.Path & "\RELATORIO PDF\COTAÇÕES\COTAÇÃO Nº " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx")
       
    'Aqui inicio o loop pelos registros da tabela
    Do While Not Rst1.EOF
    '--------------------------------------------------------------

        'Definimos qual será a planilha de trabalho
        xlw.Sheets("COTAÇÃO").Select

        'Envia o valor para cada celula (Linha, Coluna)
       
        xlw.Application.Cells(intLinha, 1).Value = Rst1![Item]
        xlw.Application.Cells(intLinha, 2).Value = Rst1![quant]
        xlw.Application.Cells(intLinha, 3).Value = Rst1![Unidade]
       
        xlw.Application.Cells(intLinha, 4).WrapText = True              'Quebra o texto
        xlw.Application.Cells(intLinha, 4).Rows.AutoFit                'Ajusta a altura
        xlw.Application.Cells(intLinha, 4).Value = Rst1![txt_produto]
       
        xlw.Application.Cells(intLinha, 5).Value = Rst1![codigo_ncm]
        xlw.Application.Cells(intLinha, 6).Value = "-"                  'ipi
        xlw.Application.Cells(intLinha, 7).Value = "-"                  'valor_unit
        xlw.Application.Cells(intLinha, 8).Value = "-"                  'valor_total
       
        'Chama a Função para desenhar as bordas da lista de Produtos
        Call BordasCelulaExcel(xlw, intLinha, 1, intLinha - 10)
        Call BordasCelulaExcel(xlw, intLinha, 2, Rst1![quant])
        Call BordasCelulaExcel(xlw, intLinha, 3, Rst1![Unidade])
        Call BordasCelulaExcel(xlw, intLinha, 4, Rst1![txt_produto])
        Call BordasCelulaExcel(xlw, intLinha, 5, Rst1![codigo_ncm])
        Call BordasCelulaExcel(xlw, intLinha, 6, " ")
        Call BordasCelulaExcel(xlw, intLinha, 7, " ")
        Call BordasCelulaExcel(xlw, intLinha, 8, " ")
       
        'Incremento o contador para mudar a linha
        intLinha = intLinha + 1
    '--------------------------------------------------------------
    Rst1.MoveNext
    Loop
   
    'Finalizo o loop
    Rst1.Close

    'Inicio a montagem do Rodapé após a lista de produtos
    With xlw.Application
    .Cells(intLinha + 1, 1).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 1, 1).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 1).Font.Bold = True                'Fonte em Nrgito
    .Cells(intLinha + 1, 1).Font.Size = 12                  'Tamanho da Fonte
    .Cells(intLinha + 1, 1).Value = "Nº ÍTENS: " & intLinha - 11
   
    .Cells(intLinha + 1, 7).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 1, 7).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 7).Font.Bold = True                'Fonte em Nrgito
    .Cells(intLinha + 1, 7).Font.Size = 12                  'Tamanho da Fonte
    .Cells(intLinha + 1, 7).Value = "TOTAL:"
   
    .Cells(intLinha + 3, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 3, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 3, 2).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 3, 2).Value = "Atenciosamente,"
   
    .Cells(intLinha + 4, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 4, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 4, 2).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 4, 2).Value = StrConv([vendedor_txt], 3)
   
    .Cells(intLinha + 5, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 5, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 5, 2).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 5, 2).Value = var_enviado_por_email
   
    .Cells(intLinha + 6, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 6, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 6, 2).Font.Size = 10                  'Tamanho da Fonte
    .Cells(intLinha + 6, 2).Value = Format([var_ddr_usuario], "(00) 0000-0000")

    End With
   
    'Para não salvar mude true para false
    xlw.Close True

    'Liberamos a memória
    Set xlw = Nothing
    set xl = nothing
'--------------------------------------------------------------

Exit Function

Fim:
    SysCmd 3
    MsgBox err.Number & " - " & err.Description
    Exit Function
End Function

Boa noite Damasceno.
Foi exatamente o que eu havia feito nas primeiras linhas e ocorreu o erro.
Só faltou acrescentar a terceira.
Amanhã pela manhã vou testar e posto o que ocorreu.
Obrigado mais uma vez.

Boa tarde Damasceno, agora funfou perfeitamente e sem referências.
Muito obrigado mesmo por sua ajuda e empenho.
Espero um dia poder ajudar também.
Fica aqui minha gratidão por seu tempo e ajuda.
Abraço