USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (VBA)

Título da Dica:  Baixar dados das tabelas para o excel
Postada em 11/12/2003 por geronimo            
Utiliza o metodo creatobjeto para lançar dados das tabelas do Acess atraves do vb para ogeral relatorios no excel:
Set BancoDeDados = OpenDatabase(App.Path & "\Tiroalvo.MDB", False)
    Set TBSúmula = BancoDeDados.OpenRecordset("Súmula", dbOpenSnapshot)
    Set TBSúmula = BancoDeDados.OpenRecordset("Select * from súmula Where [Local Competição] = '" & DBCLocal & "'and Categoria = '" & DBCCategoria & "' and [Data Competição] = #" & Format(DBCData, "mm/dd/yy") & "#  order by [Total Pontos] Desc,sociedade desc,[1tiro]desc,[2tiro]desc,[3tiro]desc,[4tiro]desc,[5tiro]desc,[6tiro]desc,[nome]desc")
  

If TBSúmula.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 ‘ determina a linha e coluna aonde serão começa a ser lançados os dados
        Screen.MousePointer = 11
        
        Set oleexcel = CreateObject("excel.application")
        Set oleworkbook = oleexcel.Workbooks.Open(App.Path & "\súmula.xls") ‘ o nome e caminho da sua planilha
        Set oleworksheet = oleexcel.Worksheets("Dados") ‘ determinha  que plan sera lançados os dados
        

DoEvents
oleworksheet.Range("a2:p1000").ClearContents ‘ limpa as colunas apartir da A2 ate P1000

‘ começa a baixar os dados da tabela
Do While Not TBSúmula.EOF
    For Y = 1 To TBSúmula.Fields.Count
        oleworksheet.Cells(X, Y) = TBSúmula.Fields(Y - 1)
    Next Y
    ‘ira deixar a primeira coluna em negrito
With oleworksheet.Range("A" & X)
    .Value = TBSúmula.Fields(0)
    .Font.Bold = True
End With

X = X + 1

TBSúmula.MoveNext
Loop

DoEvents

        TBSúmula.Close
        Screen.MousePointer = 0
        oleexcel.Visible = True
        Set TBSúmula = Nothing
        Set oleexcel = Nothing
        Set oleworkbook = Nothing
        Set oleworksheet = Nothing

    End If
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página