melissa_ff

Ajudem-me.

alguém sabe como inserir consultas em treeview usando o openschema? EStou fazendo assim com tabela, mas preciso das consultas do banco de dados Private Sub Form_Load() Set cnn = New ADODB.Connection arqdb = App.Path & "\contas a pagar.mdb" cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & arqdb cnn.Open ListaTabelas End Sub Private Sub ListaTabelas() Dim rs As ADODB.Recordset Dim table_node As Node tree1.Nodes.Clear Set rs = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE")) While rs.EOF Set table_node = tree1.Nodes.Add(, , , TABLE_NAME) table_node.Tag = "TABELA" Loop End Sub

Até consigo inserir, só que somente um registro na planilha. Vai 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 Dim l As Long '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 FROM [telefone]" ssql = ssql & "WHERE [telefone].Data Between [Data inicial] AND [Data Final]" Do While Not frmreladia.Data1.Recordset.EOF 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 End With l = l + 1 frmreladia.Data1.Recordset.MoveNext Loop 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 3010 With db.TableDefs .Delete ("asemanal") .Refresh End With Case Else MsgBox "Pronto" Screen.MousePointer = vbNormal MsgBox Err.Number & "-" & Err.Description, vbCritical + vbOKOnly End Select End Function

So esta inserindo no excel o ultimo registro 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 Do While Not frmreladia.Data1.Recordset.EOF 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 Loop End With db.QueryDefs.Delete "Relatorio" 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 Functi

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

Como usar o Between para uma consulta onde eu devo pegar registros entre datas. Estou ussando duas combobox com a data inicial e a final. estou fazendo assim: frmreladia.Data1.RecordSource = "SELECT data FROM telefone between " & Format(frmreladia.cmbdia1.Text, "mm/dd/yyyy") & "#;" And Format(frmreladia.cmbdia1.Text, "mm/dd/yyyy") & "#;"

Maravilha! Valeu amigo! Mel

Estou fazendo assim: Private Sub Form_Load() frmReld.Height = 1665 Set Data1.Recordset = db.OpenRecordset("SELECT distinct dat FROM AgendaSemanal") Data1.Refresh cmbdia.AddItem Data1.Recordset!Dat End Sub

Eu coloco essa instrucao antes de adicionar o campo na combo?E em qual evento? FormLoad?

É o seguinte: Tenho um formulario chamado relatorio onde eu preciso imprimir o relatorio correspondente a data selecionada no combo.So que no banco há , em um so dia, varios registros com a mesma data.Quero mostrar no combo a data e , ao selecionar-la, o relatorio é gerado com todos os registros daquela data. Mas so consigo mostrar as datas repetidas.Pensei que o distinct resolveria...mas não. É isso.

Como exibir dados não duplicados em um combobox.Tenho um campo data que desejo mostrar no combo, mas sem repeticao.Tentei o distinct do select e não consegui.