|
|
|
|
 |
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
|
|
|
|
|
