Relatorio No Excel

[melissa_ff]

So esta pegando o primeiro registro da tabela e inserindo no excel

Esse é o codigo:

Public Function relatoriosemana()

Dim xlApp As Excel.Application

Dim xlWork As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim ssql As String

Dim rela As QueryDef

On Error GoTo GerarPlanilha

Screen.MousePointer = vbHourglass

MsgBox "Gerando relatório..."

Set xlApp = CreateObject("EXCEL.Application")

Set xlWork = xlApp.Workbooks.Open("C:\Documents and Settings\melissa\Usr\vb\AgendaDia.xls")

Set xlWork = xlApp.Workbooks(1)

Set xlSheet = xlApp.Worksheets("Dados")

Set rela = db.QueryDefs("Relatorio")

ssql = "SELECT [telefone].Data,[telefone].nome,[telefone].tel,[telefone].ligacao into asemanal FROM [telefone]"

ssql = ssql & "WHERE [telefone].Data Between [Data inicial] AND [Data Final]"

With rela

.SQL = ssql

.Parameters("Data inicial") = frmreladia.cmbdia1

.Parameters("Data final") = frmreladia.cmbdia2

.Execute

xlSheet.Cells(5, 1) = Format(frmreladia.Data1.Recordset("data"), "mm/dd/yyyy")

xlSheet.Cells(5, 1).Borders.LineStyle = 3

xlSheet.Cells(5, 1).Borders.Weight = 1

xlSheet.Cells(5, 1).Font.Name = "Verdana"

xlSheet.Cells(5, 1).Font.Size = 7

xlSheet.Cells(5, 2) = frmreladia.Data1.Recordset("Nome")

xlSheet.Cells(5, 2).Borders.LineStyle = 3

xlSheet.Cells(5, 2).Borders.Weight = 1

xlSheet.Cells(5, 2).Font.Name = "Verdana"

xlSheet.Cells(5, 2).Font.Size = 7

xlSheet.Cells(5, 3) = frmreladia.Data1.Recordset("Tel")

If bCinza Then xlSheet.Cells(5, 3).Interior.ColorIndex = 15

xlSheet.Cells(5, 3).Borders.LineStyle = 3

xlSheet.Cells(5, 3).Borders.Weight = 1

xlSheet.Cells(5, 3).Font.Name = "Verdana"

xlSheet.Cells(5, 3).Font.Size = 7

xlSheet.Cells(5, 4) = frmreladia.Data1.Recordset("Ligacao")

If bCinza Then xlSheet.Cells(5, 4).Interior.ColorIndex = 15

xlSheet.Cells(5, 4).Borders.LineStyle = 3

xlSheet.Cells(5, 4).Borders.Weight = 1

xlSheet.Cells(5, 4).Font.Name = "Verdana"

xlSheet.Cells(5, 4).Font.Size = 7

frmreladia.Data1.Recordset.MoveNext

End With

xlWork.Close True

xlApp.Quit

Set xlApp = Nothing

GerarPlanilha:

Select Case Err

Case 0

MsgBox "Pronto"

Screen.MousePointer = vbNormal

MsgBox "Relatório gerado com sucesso.", vbOKOnly + vbInformation

Shell "C:\Arquivos de programas\Microsoft Office\Office\excel.exe \\melissa\Usr\vb\AgendaDia.xls"

Case 1004

Unload frmreladia

MsgBox "Pronto"

Screen.MousePointer = vbNormal

MsgBox "O caminho não foi encontrado, por favor mude o caminho" & Chr(13) & " nas configurações e tente gerar o mapa novamente!", vbCritical + vbOKOnly

xlWork.Close True

xlApp.Quit

Set xlApp = Nothing

Case Else

MsgBox "Pronto"

Screen.MousePointer = vbNormal

MsgBox Err.Number & "-" & Err.Description, vbCritical + vbOKOnly

End Select

End Function

[Guest pajezinhu]

So esta pegando o primeiro registro da tabela e inserindo no excel

Esse é o codigo:

Public Function relatoriosemana()

Dim xlApp As Excel.Application

Dim xlWork As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim ssql As String

Dim rela As QueryDef

On Error GoTo GerarPlanilha

Screen.MousePointer = vbHourglass

MsgBox "Gerando relatório..."

Set xlApp = CreateObject("EXCEL.Application")

Set xlWork = xlApp.Workbooks.Open("C:\Documents and Settings\melissa\Usr\vb\AgendaDia.xls")

Set xlWork = xlApp.Workbooks(1)

Set xlSheet = xlApp.Worksheets("Dados")

Set rela = db.QueryDefs("Relatorio")

ssql = "SELECT [telefone].Data,[telefone].nome,[telefone].tel,[telefone].ligacao into asemanal FROM [telefone]"

ssql = ssql & "WHERE [telefone].Data Between [Data inicial] AND [Data Final]"

With rela

.SQL = ssql

.Parameters("Data inicial") = frmreladia.cmbdia1

.Parameters("Data final") = frmreladia.cmbdia2

.Execute

xlSheet.Cells(5, 1) = Format(frmreladia.Data1.Recordset("data"), "mm/dd/yyyy")

xlSheet.Cells(5, 1).Borders.LineStyle = 3

xlSheet.Cells(5, 1).Borders.Weight = 1

xlSheet.Cells(5, 1).Font.Name = "Verdana"

xlSheet.Cells(5, 1).Font.Size = 7

...

End Function

faça um loop apos a conexao para que ela va rodando os registro utilizando o comando movenext e verificando se o registro não é nulo para continuar e quando for nulo ele para de exibir

e em:

xlSheet.Cells(5, 1) = Format(frmreladia.Data1.Recordset("data"), "mm/dd/yyyy")

xlSheet.Cells(5, 1).Borders.LineStyle = 3

xlSheet.Cells(5, 1).Borders.Weight = 1

xlSheet.Cells(5, 1).Font.Name = "Verdana"

xlSheet.Cells(5, 1).Font.Size = 7

você troca o 1 por uma variavel (contador) que vai de 1 em 1. assim criando um registro apos o outro. Inclua o movenext ap´s estas intruções.

espero ter ajudado.

pajezinhu@hotmail.com

[Guest pajezinhu]

só corrigindo.... no seu código só faltou o loop. =)