EXPORTAR DADOS DE UM BANCO PARA EXCEL

Private Sub sub_GeraArquivo()
On Error GoTo erro
Dim cmdComissao As ADODB.Command
Set cmdComissao = New ADODB.Command
Dim SQL As String
Dim VAR_Total As Currency
VAR_Total = 0
Dim I As Long
frm_Aviso.Show

DoEvents
'GERANDO ARQUIVO P/ EXCEL ******************************************
   Dim exclApp As Object
   Dim exclBook As Object
   Dim exclSheet As Object

   'Carregar o Excel:
   Set exclApp = CreateObject("Excel.Application")
   'Crie um WorkBook:
   Set exclBook = exclApp.Workbooks.Add

   'Definindo a planilha ativa
   Set exclSheet = exclApp.ActiveWorkbook.ActiveSheet
'*********************************************************************
   With exclSheet
        .PageSetup.Zoom = 75
        .Columns("A:A").ColumnWidth = 30
        .Columns("B:C").ColumnWidth = 10
        .Columns("D").ColumnWidth = 10
        .Columns("E").ColumnWidth = 30
        .Columns("F").ColumnWidth = 10
        .Columns("G").ColumnWidth = 10
        .Columns("H").ColumnWidth = 10
        .Columns("I").ColumnWidth = 10
        .Columns("J").ColumnWidth = 10
        .Range("A1:J13").Font.Bold = True 'Negrito nas células
        .Columns("B:D").HorizontalAlignment = xlCenter
        .Columns("F:J").HorizontalAlignment = xlCenter
        .Cells(1, 1).Value = "RELATÓ“RIO DE COMISSÕES PENDENTES "
        .Cells(1, 8).Value = Format(Date, "DD/MM/YYYY")
        
        .Range("A1:C1").MergeCells = True 'Mesclando as células
        .Range("C2:D2").MergeCells = True 'Mesclando as células
        .Cells(3, 1).Value = "CORRETOR"
        .Cells(3, 2).Value = "APÓ“LICE"
        .Cells(3, 3).Value = "ENDOSSO"
        .Cells(3, 4).Value = "PARCELA"
        .Cells(3, 5).Value = "SEGURADO"
        .Cells(3, 6).Value = "DATA"
        .Cells(3, 7).Value = "VIGÃÅ NCIA"
        .Cells(3, 8).Value = "PRÃÅ MIO"
        .Cells(3, 9).Value = "COM. %"
        .Cells(3, 10).Value = "%"
        .Cells(3, 11).Value = "RAMO"
         
        .Range("A3:K3").Borders.LineStyle = xlContinuous 'Colocando borda na tabela
         

        
         'Salvar o Arquivo
         '.SaveAs "c:    este.xls"
   End With

I = 4
'
'
With cmdComissao
    SQL = "SELECT * FROM Corretor a LEFT JOIN Plataforma b "
    SQL = SQL & " ON (a.cor_Apolice = b.pla_Apolice "
    SQL = SQL & " AND a.cor_Endosso =b.Pla_Endosso AND a.cor_Parcela =  b.pla_Parcela )"
    SQL = SQL & " WHERE IsNull(b.Pla_Apolice) ORDER BY Cor_Nome,Cor_Parcela"
    .ActiveConnection = cnComissao
    .CommandText = SQL
    Set rsComissao = .Execute
    Do While Not rsComissao.EOF
        exclSheet.Cells(I, 1).Value = rsComissao!cor_Nome
        exclSheet.Cells(I, 2).Value = rsComissao!cor_Apolice
        exclSheet.Cells(I, 3).Value = rsComissao!cor_Endosso
        exclSheet.Cells(I, 4).Value = Format(CStr(rsComissao!cor_Parcela), "000")
        exclSheet.Cells(I, 5).Value = rsComissao!cor_Segurado
        exclSheet.Cells(I, 6).Value = CDate(rsComissao!cor_Data)
        exclSheet.Cells(I, 7).Value = CDate(rsComissao!cor_Vigencia)
        exclSheet.Cells(I, 8).Value = CCur(rsComissao!cor_Premio)
        exclSheet.Cells(I, 9).Value = CCur(rsComissao!cor_ComissaoValor)
        exclSheet.Cells(I, 10).Value = rsComissao!cor_Comissao
        exclSheet.Cells(I, 11).Value = Format(CStr(rsComissao!cor_Ramo), "000")
        exclSheet.Range("A" & I & ":K" & I).Font.Bold = False
        I = I + 1
        VAR_Total = VAR_Total + rsComissao!cor_ComissaoValor
        rsComissao.MoveNext
    Loop
End With
exclSheet.Cells(I, 8) = "TOTAL"
exclSheet.Cells(I, 9) = VAR_Total
exclSheet.Range("H" & I & ":I" & I).Font.Bold = True
'exclSheet.Cells(i, 3) = Var_TotalFechadas
    
    exclApp.Visible = True
    exclApp.UserControl = True

   'Limpe as variáveis de Objeto:
   Set exclSheet = Nothing
   Set exclBook = Nothing
   Set exclApp = Nothing


erro:
    If Err.Number <> 0 Then
            MsgBox "Ocorreu um erro, favor contactar o administrador do sistema " & vbCrLf _
                & "erro: " & Err.Number & " " & Err.Description, vbExclamation, "AVISO"
    End If

End Sub

Public Function ExportaFlex(xQueFlex as  MSFlexGrid)
Dim xCol, xRow
Dim xLetra
Dim xRange

    xLetra="ABCDEFG" 'ou EFGHIJK ou JKLMNOP <=== a sequencia de colunas da planilha que você vai usar

    For xRow = 1 to xQueFlex.Rows-1
        xQueFelx.Row=xRow
        For xCol= 1 to xQueFlex.Cols-1
            xRange=MID$(xLetra,xCol,1) & xCol
            xQueFlex.Col=xCol
            Range(xRange).Value=xQueFlex.Text
        Next
    Next
End Function