Exportar para Excel e formatar algumas colunas

Olá a todos,

Eu peguei o exemplo do JPAULO e alterei um pouco para exportar alguns dados para o Excel e formatar a primeira linha, colocar decimais na coluna D e autoajuste em todas as colunas.
O Exemplo verifica se o arquivo existe no Desktop usuário e, caso existe apenas o preenche, senão, cria o arquivo e o preenche.

Sei que parece amador, mas não conheço muito de VBA. De qualquer forma espero que ajude alguém.

Código:

Dim db As DAO.DATABASE
Dim strConta As String
Dim xls As Object
Dim rst As DAO.Recordset
Dim strSQL
Dim intUltimaCelula%
Dim xlsht As Excel.Worksheet
Dim strCaminho As String
Dim verCaminho As String

Set db = CurrentDb
Set xls = CreateObject("Excel.Application")

 strCaminho = VBA.Environ("userprofile") & "\desktop\"

strConta = strCaminho & "SaldosDeContasCorrentes.xlsx"

verCaminho = Dir(strConta)
  'verifica se o arquivo existe no desktop do usuário
   If verCaminho = "SaldosDeContasCorrentes.xlsx" Then
           xls.Workbooks.Open (strConta)
               Set xlsht = xls.Worksheets(1) ' 1 é a primeira planilha
           xls.Visible = True 'torna o excel visivel
           
           strSQL = "SELECT tSaldoCC.ContaCorrente AS ContaCorrente, tSaldoCC.DataSaldo AS DataSaldo, tSaldoCC.ProgEsp AS Programa, tSaldoCC.SaldoConta AS SaldoConta   " & _
                    "FROM tSaldoCC " & _
                    "WHERE ContaCorrente <> NULL AND DataSaldo>=#1/1/2019# " & _
                    "ORDER BY tSaldoCC.ContaCorrente, tSaldoCC.DataSaldo DESC, tSaldoCC.ProgEsp"
           
           Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
           
           If rst.RecordCount = 0 Then Exit Sub 'se não tem registros, morre aqui
               xls.Worksheets(1).Activate
               xls.ActiveSheet.Range("A1").Select 'seleciona a primeira celula
               xls.ActiveSheet.Range("A1").Value = "CONTA"
               xls.ActiveSheet.Range("A1").Font.Bold = True
               xls.ActiveSheet.Range("B1").Value = "DATA"
               xls.ActiveSheet.Range("B1").Font.Bold = True
               xls.ActiveSheet.Range("C1").Value = "PROGRAMA"
               xls.ActiveSheet.Range("C1").Font.Bold = True
               xls.ActiveSheet.Range("D1").Value = "SALDO"
               xls.ActiveSheet.Range("D1").Font.Bold = True
           
                   intUltimaCelula = xlsht.Cells(xlsht.Rows.Count, 1).End(xlUp).Row 'obtem a ultima celula preenchida
                   intUltimaCelula = intUltimaCelula + 1 'acrescenta mais uma celula, que será a vazia
                   xls.ActiveSheet.Range("A" & intUltimaCelula).Select 'seleciona-a
           
                   xls.ActiveCell.CopyFromRecordset rst 'copia os dados da tabela
           
                   xls.ActiveSheet.Columns("D").NumberFormat = "#,##0.00"
                   xls.ActiveSheet.Columns("A").AutoFit
                   xls.ActiveSheet.Columns("B").AutoFit
                   xls.ActiveSheet.Columns("C").AutoFit
                   xls.ActiveSheet.Columns("D").AutoFit
           
           'fecha o recordset e limpa a memoria
           rst.Close: Set rst = Nothing
           'salva o excel
           xls.ActiveWorkbook.Save
           'fecha o excel
           xls.Application.Quit
           'limpa a memoria
           Set xls = Nothing
       Else
               'Cria o arquivo caso ele não exista
               Dim newbook As Object
               Set newbook = Workbooks.Add
               With newbook
                   .SaveAs FileName:=strConta
               End With
           
                   xls.Workbooks.Open (strConta)
                       Set xlsht = xls.Worksheets(1) ' 1 é a primeira planilha
                   xls.Visible = True 'torna o excel visivel
                   
                   strSQL = "SELECT tSaldoCC.ContaCorrente AS ContaCorrente, tSaldoCC.DataSaldo AS DataSaldo, tSaldoCC.ProgEsp AS Programa, tSaldoCC.SaldoConta AS SaldoConta   " & _
                            "FROM tSaldoCC " & _
                            "WHERE ContaCorrente <> NULL AND DataSaldo>=#1/1/2019# " & _
                            "ORDER BY tSaldoCC.ContaCorrente, tSaldoCC.DataSaldo DESC, tSaldoCC.ProgEsp"
                   
                   Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
                   
                   If rst.RecordCount = 0 Then Exit Sub 'se não tem registros, morre aqui
                       xls.Worksheets(1).Activate
                       xls.ActiveSheet.Range("A1").Select 'seleciona a primeira celula
                       xls.ActiveSheet.Range("A1").Value = "CONTA"
                       xls.ActiveSheet.Range("A1").Font.Bold = True
                       xls.ActiveSheet.Range("B1").Value = "DATA"
                       xls.ActiveSheet.Range("B1").Font.Bold = True
                       xls.ActiveSheet.Range("C1").Value = "PROGRAMA"
                       xls.ActiveSheet.Range("C1").Font.Bold = True
                       xls.ActiveSheet.Range("D1").Value = "SALDO"
                       xls.ActiveSheet.Range("D1").Font.Bold = True
                   
                           intUltimaCelula = xlsht.Cells(xlsht.Rows.Count, 1).End(xlUp).Row 'obtem a ultima celula preenchida
                           intUltimaCelula = intUltimaCelula + 1 'acrescenta mais uma celula, que será a vazia
                           xls.ActiveSheet.Range("A" & intUltimaCelula).Select 'seleciona-a
                   
                           xls.ActiveCell.CopyFromRecordset rst 'copia os dados da tabela
                   
                           xls.ActiveSheet.Columns("D").NumberFormat = "#,##0.00"
                           xls.ActiveSheet.Columns("A").AutoFit
                           xls.ActiveSheet.Columns("B").AutoFit
                           xls.ActiveSheet.Columns("C").AutoFit
                           xls.ActiveSheet.Columns("D").AutoFit
                   
                   'fecha o recordset e limpa a memoria
                   rst.Close: Set rst = Nothing
                   'salva o excel
                   xls.ActiveWorkbook.Save
                   'fecha o excel
                   xls.Application.Quit
                   'limpa a memoria
                   Set xls = Nothing
   End If

Obrigado por compartilhar. E parabéns pela iniciativa.