Moçada, como eu faço para pegar minha grid ou tabela e via código converter num arquivo.xls ?

 

+ 1 vez   Grato

 

Fui !!!!

Um exemplo de utilização do método CreateObject para escrever uma planilha de Excel, independente da versão que você tem instalado em seu computador.
Dim BancoDeDados As Database
Dim x As Integer
Dim y As Integer
Dim Z As Integer
Dim old_soci As String, i As Integer
Dim TBSúmula As Recordset
Dim tbpontos As Recordset
Dim tbauxtemp As Recordset

    
    Set BancoDeDados = OpenDatabase(App.Path & "Tiroalvo.MDB", False)
    Set TBSúmula = BancoDeDados.OpenRecordset("Súmula", dbOpenSnapshot)
    Set tbpontos = BancoDeDados.OpenRecordset("Select sum([Total Pontos] ) As Total,sociedade from súmula Where Local = '" & DBCLocal & "'and Categoria = '" & DBCCategoria & "' and Data = #" & Format(DBCData, "mm/dd/yy") & "#  group by sociedade order by sum([Total Pontos]) DESC")
  

If tbpontos.EOF Then 'Não retornou nenhum registro
        MsgBox "Não há Dados para Visualizar Nesta:" & Chr(13) & "Categoria, Data e Local de Competição", 48, "Tiro Alvo Seta"
    Else
        x = 2 ' Local aonde serão inseridos os dados neste caso coluna A linha 2
        Z = 15 ' Local aonde serão inseridos os proximos dados se existir uma sociedade diferente nas tabelas
        Screen.MousePointer = 11
        
        Set oleexcel = CreateObject("excel.application")
        Set oleworkbook = oleexcel.Workbooks.Open(App.Path & "ouro.xls") ' chama a planilha existente
        Set oleworksheet = oleexcel.Worksheets("Dados") ' a plan que ira receber os dados
        
DoEvents
oleworksheet.Range("a2:p1000").ClearContents '  limpa todas as celulas para receber as novas informações
While Not tbpontos.EOF
    Sociedade_atual = tbpontos("sociedade")
    Set tbauxtemp = BancoDeDados.OpenRecordset("Select * from súmula where sociedade='" & Sociedade_atual & "'and Local = '" & DBCLocal & "'and Categoria = '" & DBCCategoria & "' and Data = #" & Format(DBCData, "mm/dd/yy") & "# order by [Total Pontos] Desc,[1tiro]desc,[2tiro]desc,[3tiro]desc,[4tiro]desc,[5tiro]desc,[6tiro]desc,[nome]desc")
    i = 0
    Do
        'Rotina para mandar para o excel
        For y = 1 To tbauxtemp.Fields.Count
            oleworksheet.Cells(x, y) = tbauxtemp.Fields(y - 1)
        Next y
                        
        With oleworksheet.Range("A" & x)
            .Value = tbauxtemp.Fields(0)
            .Font.Bold = True
        End With
        x = x + 1
        Z = X2 + 15
        'Manda para o Excel os 15 dessa sociedade
        i = i + 1
        tbauxtemp.MoveNext
    Loop Until i = 15 Or tbauxtemp.EOF 'Acrescentei o tbauxtemp.eof para o caso de so haver 1 registro...
    Do

        'Move até a próxima sociedade
        tbpontos.MoveNext
       If tbpontos.EOF Then Exit Do
    Loop Until Sociedade_atual <> tbpontos("sociedade")
    Z = Z - i
    x = x + Z
Wend
        DoEvents
        tbauxtemp.Close
        tbpontos.Close
        Screen.MousePointer = 0
        oleexcel.Visible = True
        Set tbpontos = Nothing
        Set tbauxtemp = Nothing
        Set oleexcel = Nothing
        Set oleworkbook = Nothing
        Set oleworksheet = Nothing

    End If