|
|
|
|
 |
Título da Dica: Exemplo de como criar uma Planilha do Excel
|
 |
|
|
|
Postada em 11/12/2003 por geronimo
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
|
|
|
|
|
