COMO MANIPULAR AS COLUNAS DO EXCEL

Private Sub Command1_Click()
    Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    
    Dim xlApp As Object, xlWb As Object, xlWs As Object
    Dim recArray As Variant
    Dim strDB As String, strPlan As String
    Dim iCol As Integer, iRow As Integer, fldCount As Integer
    Dim recCount As Long
    
    
    ' Caminho do banco de dados e nome da tabela, mude esse dados
    strDB = "c:    este.mdb"
    strPlan = "Pedidos"
    
  
    ' Abrindo a conexão com a base de dados
    cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDB & ";"
        
    ' Abrindo a tabela com sql
    rst.Open "Select * From " & strPlan, cnt
    
    ' Criando a instancia do Excel e criando uma planilha
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets(1) '("Sheet1")
  
    ' Mostrar o Excel e liberar os controles de usuário para o Excel
    xlApp.Visible = True
    xlApp.UserControl = True
    
    ' Copiando os nomes dos campos para a primeira linha da planilha
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next
        
    ' Verificando a versão do Excel
    If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000 ou 2002: Use CopyFromRecordset
         
        ' Transferindo os dados para a planilha,
        ' iniciando na célula A2
        xlWs.Cells(2, 1).CopyFromRecordset rst
        
    Else
        'Para EXCEL antigo como 97
    

        recArray = rst.GetRows
        
        ' Determinando numero de registros

        recCount = UBound(recArray, 2) + 1
        

        ' Verificando o conteúdo para evitar dados inválidos e
        ' copiando os dados para a planilha do Excel
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Formatando campo do tipo data
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Prevenção de erro por objeto OLE ou campo com array
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'proximo registro
        Next iCol 'proximo campo
            
        ' Transferindo os dados para a planilha,
        ' iniciando na célula A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

    ' Auto-redimensiona as colunas ao seu conteúdo
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

    ' Fecha os objetos ADO
    rst.Close
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    
    ' Libera as referencias ao Excel
    Set xlWs = Nothing
    Set xlWb = Nothing

    Set xlApp = Nothing

End Sub

Function TransposeDim(v As Variant) As Variant
  
    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    
    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)
    
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X
    
    TransposeDim = tempArray

End Function