Macêdo

Coloque no form 4 textBox e 1 Botão No gerneral declarations: Dim db As Database A sub que fará o trabalho: Private Sub ExportaExcel(nomepasta As String, caminhoplanilha As _ String, nometabela As String, caminhobd As String) Dim db As Database Set db = OpenDatabase(caminhoplanilha, True, False, "Excel 5.0") Call db.Execute("Select * into [;database=" & caminhobd & "]." & nometabela & " FROM [" & nomepasta & "$]") MsgBox "Tabela Exportada com Sucesso", vbInformation, "JcmSoft" End Sub Comando do Botão para realizar a exportação, chamando a sub: Private Sub Command1_Click() On Error GoTo trata_erro ExportaExcel text2.Text, text1.Text, text4.Text, text3.Text Exit Sub trata_erro: MsgBox Err.Number & " - " & Err.Description Exit Sub End Sub Na text1 coloque o endereço do arquivo do excel Na text2 coloque o nome da planilha Na text3 coloque o endereço do banco Access.mdb onde quer gravar os dados da planilha Na text4 coloque o nome da tabela que será criada no BD access com os campos da planilha excel exemplo: text1: C:\Documents and Settings\Usuario\Desktop\Nova pasta\pasta1.xls text2: plan1 text3: C:\Documents and Settings\Usuario\Desktop\Nova pasta\teste.mdb text4: teste

No módulo: Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Public Ret As String Public Sub WriteINI(filename As String, Section As String, Key As String, Text As String) WritePrivateProfileString Section, Key, Text, filename End Sub Public Function ReadINI(filename As String, Section As String, Key As String) Ret = Space$(255) RetLen = GetPrivateProfileString(Section, Key, "", Ret, Len(Ret), filename) Ret = Left$(Ret, RetLen) ReadINI = Ret End Function No form: pra gravar: 'altere o caminho da pasta onde quer gravar o arquivo WriteINI "c:\windows\conf.ini", "teste", "teste", text1 pra ler: text1 = ReadINI("C:\Windows\conf.ini", "teste", "teste")

Vamos pegar os dados de uma tabela do BD que aparecem no Msflexgrid ou MsHflexgrid e salvar em arquivos como Word, Excel, HTML, Txt, PowerPoint etc No Form coloque um TextBox, um MsHflexgrid ou Msflexgrid e um Botão No general Declarations do Form declare: Dim cnn As New ADODB.Connection Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset No evento Form_Load vamos abrir a conexão com o BD, carregar o recordset e preencher o MshflexGrid com os dados do "rs" Private Sub Form_Load() 'abrindo a conexão com o Banco BD que esta na mesma pasta do projeto cnn.ConnectionString = "provider = microsoft.jet.oledb.4.0;" & _ "data Source = " & App.Path & "\BD.mdb;" cnn.CursorLocation = adUseClient cnn.Open 'carregando o recordset com campos desejados da tabela With cmd .ActiveConnection = cnn .CommandType = adCmdText .CommandText = "select campo1, campo2, campo3 from tabela" Set rs = .Execute End With 'carregando o Mshflex com o recordset With rs Set MSHFlexGrid1.DataSource = rs End With End Sub agora vamos criar a Sub que vai gerar o arquivo desejado no caminho que iremos informar no textbox Private Sub gerar_arquivo(ByVal strFilename As String, ByRef msFlex As MSHFlexGrid) Const SEPARATOR_CHAR As String = " " Dim intFreeFile As Integer Dim strLine As String Dim r As Integer Dim c As Integer intFreeFile = FreeFile Open strFilename For Output As #intFreeFile With msFlex ' cada linha For r = 0 To .Rows - 1 strLine = "" ' cada coluna For c = 0 To .Cols - 1 strLine = strLine & IIf(c = 0, "", SEPARATOR_CHAR) & .TextMatrix(r, c) Next c Print #intFreeFile, strLine Next r End With Close #intFreeFile End Sub Agora vamos ao botão que chamará a sub para gerar nosso arquivo Private Sub Command1_Click() Call gerar_arquivo(Text1.Text, MSHFlexGrid1) MsgBox "Arquivo " & Text1.Text & " Salvo com sucesso !", vbInformation End Sub Agora você deve estar perguntando, e para gerar no Word, Excel, HTML ?, o esquema está no TextBox, é nele que você vai digitar o caminho da pasta onde quer criar seu arquivo, vai colocar o nome do arquivo e o tipo de arquivo, assim: Quer gerar um arquivo do Word? digite na text: C:\Arquivos de programas\MeuArquivo.Doc Quer gerar um arquivo Txt? digite na text: C:\Arquivos de programas\MeuArquivo.Txt Quer criar uma planilha no Excel? digite na text: C:\Arquivos de programas\MeuArquivo.xls HTML? C:\Arquivos de programas\MeuArquivo.html Taí pode ser util... Macêdo

Bom pessoal, implementei a seguinte função para melhorar uma dica postada por mim aqui mesmo nesta seção que mostra como fazer uma mascara de data num textBox, pois colocando esta função num modulo basta chama-la com uma pequena linha de codigo e todos os textbox de um programa, que sejam text de DATA serão formatados com a mascara de DATA e ainda não permitirá digitar letras nos campos DATA e a tecla BackSpace funcionará perfeitamente. Ponha num módulo Function DATA(obj As Object, KeyCode As Integer) If ((KeyCode < 97 And KeyCode > 105) Or KeyCode = 8) Then KeyCode = 0 Exit Function End If If KeyCode <> 8 Then If Len(obj.Text) = 2 Or Len(obj.Text) = 5 Then obj.Text = obj.Text + "/" obj.SelStart = Len(obj.Text) End If End If End Function Para usa-la em seus campos data chame-a assim: Obs: observem que deve ser usada no evento KeyUp, ou KeyDown, mas acho que fica ainda melhor no KeyUp pois a "/" da data aparecerá logo que o ultimo numero anterior à ela for digitado, e altere o nome da TextBox, no meu caso a text1 seria meu campo data, então poderá ter quantas text's for como campo data que basta chamar a mesma função no evento da text e pronto! Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) DATA Text1, KeyCode End Sub

usa um do while após uma contagem, assim: 1º pede pra retornar num select quantos registros iguais a este existem na tabela 2º com um Do While implementa na Insert Into para se o Recordcount for menor que a quantidade de vezes que você quer que este registro exista na tabela então continua a incluir 3º quando o recordcount for igual a quantidade devezes que você quer que repita então o Do While para de inserir, ficando então com a quantidade exata de registros iguais que você quer Deu pra entender?

Acho que seria melhor usar um FOR NEXT, pois imagina ter que colocar tantas quantas forem as linhas preenchidas do Flex?

Gabriel: If Not rs_relatorio.EOF Then Else troque por: If not(.BOF and .EOF) then 'se encontrou algo no periodo else 'se não encontrou

Kuroi, yyyy/mm/dd não seria MySQL ? eu acho que o gabriel trabalha com access então sera mm/dd/yyyy Dim Conex As New ADODB.Connection Conex.Open StringDeConexao With cmd_relatorio .ActiveConnection = Conex .CommandType = adCmdText .CommandText = "SELECT * FROM FinanWin_Contas WHERE isNull(Con_ValorPgtoCP) AND Con_Tipo = 'CP' AND Con_Venc BETWEEN #" & format(txtDataInicial,"mm/dd/yyyy") & "# AND #" & format(txtDataFinal,"mm/dd/yyyy") & "# ORDER BY Con_Venc" Set rs_relatorio = .Execute End With If Not rs_relatorio.EOF Then rptConPData.Sections("Section2").Controls.Item("lblPeriodo").Caption = "Período de Referência: " & Format(txtDataInicial, "DD/MM/YYYY") & " a " & Format(txtDataFinal, "DD/MM/YYYY") With rptConPData Set .DataSource = rs_relatorio .DataMember = "" .Refresh .Show End With Else MsgBox "Não há registros neste período.", vbExclamation txtDataInicial.SetFocus End If

a senha você informa na conexão assim: cnn.ConnectionString = "provider = microsoft.jet.oledb.4.0;" & _ "data Source = " & App.Path & "\BD.mdb; jet OLEDB:Database Password=senha_aqui" cnn.CursorLocation = adUseClient cnn.Open

tenta este: http://scriptbrasil.com.br/forum/index.php?showtopic=103757

Posta teu codigo da busca todo pra ver como tu ta fazendo

Faça o seguinte teste: select categoria, ano from cadastro where categoria like 'Mini Feminino' and categoria like 'Mini Masculino' and ano like '2008'

Coloque no Form: Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Public Enum eModeLocal emlUsername = 0 emlPCName = 1 End Enum Public Function LocalStationInfo(bMode As eModeLocal) As String Dim Buffer As String Const MAX_COMPUTERNAME_LENGTH = 31 Const UNLEN = 256 If bMode = emlPCName Then Buffer = Space(MAX_COMPUTERNAME_LENGTH + 1) GetComputerName Buffer, Len(Buffer) LocalStationInfo = Buffer End If If bMode = emlUsername Then Buffer = Space(0) Buffer = Space(UNLEN + 1) GetUserName Buffer, Len(Buffer) LocalStationInfo = Buffer End If End Function Agora ponha uma StatusBar e insira dois Panels e coloque o seguinte codigo no Load do Form: Private Sub Form_Load() StatusBar1.Panels(1).Text = "Usuário Logado: " + (LocalStationInfo(emlUsername)) StatusBar1.Panels(2).Text = "Acessando Programa da estação : " + (LocalStationInfo(emlPCName)) End Sub Beleza ?

Para carregar uma combo com os dados de um campo da tabela faça a seguinte sub: Não esquecendo que devemos estar com um conexão "cnn" aberta e declarar no General Declarations do Form: Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset Agora a sub, digamos que vamos preencher a combo COMBO_NOME com o NOME dos clientes da tabela CLIENTES Private Sub preencher_combo() 'preenchendo o recordset com os nomes da tabela With cmd .ActiveConnection = cnn .CommandType = adCmdText .CommandText = "select NOME from CLIENTES" Set rs = .Execute End With 'jogando os nomes do recordset na combo With rs Do While Not rs.EOF 'enquanto não chegar ao final dos registros If Not IsNull(rs!NOME) Then 'se o campo não tiver valor nulo, isto evita criar espaços em branco COMBO_NOME.AddItem rs!NOME 'adiciona o registro à combo End If rs.MoveNext 'move para o proximo registro Loop End With End Sub Chame a sub para preencher a combo: Private Sub Form_Load() preencher_combo End Sub

Vamos dar continuidade ao tópico onde mostrei como visualizar num DataGrid os campos de uma tabela do BD: http://scriptbrasil.com.br/forum/index.php?showtopic=115963 Vamos relembrar: No General Declarations do Form vamos colcocar: Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset Dim vinfo As Integer Agora nossa sub para preencher o DataGrid com os campos da tabela CLIENTES: Private Sub preenche_grid() 'o command retornando nossos campos e enchendo o Recordset With cmd .ActiveConnection = cnn .CommandType = adCmdText .CommandText = "select Cod, nome, nascimento from clientes" Set rs = .Execute End With 'preenchedo nosso Datagrid com os valores dos campos e configurando tamanho, nome, alinhamento e tipo dos campos With rs Set DataGrid1.DataSource = rs DataGrid1.Caption = "CLIENTES CADASTRADOS" DataGrid1.MarqueeStyle = dbgHighlightRowRaiseCell DataGrid1.Columns.Item(0).Caption = "Cod" DataGrid1.Columns.Item(0).Width = 800 DataGrid1.Columns.Item(1).Caption = "Nome" DataGrid1.Columns.Item(1).Width = 4200 DataGrid1.Columns.Item(2).Caption = "Nascimento" DataGrid1.Columns.Item(2).NumberFormat = "dd/mm/yyyy" DataGrid1.Columns.Item(2).Width = 1100 DataGrid1.Columns.Item(2).Alignment = dbgCenter End With End Sub Para que nossa sub preencha o DataGrid vamos chama-la no form_Load: Private Sub Form_Load() preenche_grid End Sub Agora vamos ao filtro, para isto teremos nossa Text_nome, onde digitaremos o nome para fazer a busca, vamos colocar o seguinte codigo no evento Change da text: Private Sub Text_nome_Change() With rs If Text_nome <> "" Then .Filter = "nome like '" & Text_nome & "%'" .Sort = "nome" End If End With End Sub Veja que ao ir digitando o nome na text o filtro vai acontecendo no DataGrid pela ordem dos caracteres digitados

Bom galera, primeiro mostrei como se conectar a um BD usando ADO: http://scriptbrasil.com.br/forum/index.php?showtopic=103750 Depois como inserir registros no BD: http://scriptbrasil.com.br/forum/index.php?showtopic=115960 Agora vou passar como visualizar os dados de uma tabela do BD num Datagrid e configurar o Datagrid Vamos lembrar que no declarations do Form devemos ter sempre os seguintes objetos 'objeto command que irá inserir, excluir etc.. dados no BD 'Recodset que trará valores da tabela em nossas consultas '(vinfo) variavel que usaremos para chamar sempre que preciso uma MsgBox Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset Dim vinfo As Integer 'através de um Command (cmd) retornaremos os dados e povoaremos um recordset (rs) para preenchermos o Datagrid com os dados da tabela/recordset Nossa sub (teremos como base nossa tabela clientes dos exemplos anteriores) Digamos que queremos preencher o datagrid com os campos (Cod, nome, nascimento) da nossa tabela Private Sub preenche_grid() 'o command retornando nossos campos e enchendo o Recordset With cmd .ActiveConnection = cnn .CommandType = adCmdText .CommandText = "select Cod, nome, nascimento from clientes" Set rs = .Execute End With 'preenchedo nosso Datagrid com os valores dos campos e configurando tamanho, nome, alinhamento e tipo dos campos With rs Set DataGrid1.DataSource = rs DataGrid1.Caption = "CLIENTES CADASTRADOS" DataGrid1.MarqueeStyle = dbgHighlightRowRaiseCell DataGrid1.Columns.Item(0).Caption = "Cod" DataGrid1.Columns.Item(0).Width = 800 DataGrid1.Columns.Item(1).Caption = "Nome" DataGrid1.Columns.Item(1).Width = 4200 DataGrid1.Columns.Item(2).Caption = "Nascimento" DataGrid1.Columns.Item(2).NumberFormat = "dd/mm/yyyy" DataGrid1.Columns.Item(2).Width = 1100 DataGrid1.Columns.Item(2).Alignment = dbgCenter End With End Sub Agora é só por num evento que quisermos para que nosso Datagrid seja preenchido, neste caso, no Load do Form Private Sub Form_Load() preenche_grid End Sub

Bom galera numa dica anterior mostrei como acessar um Banco de Dados via ADO: http://scriptbrasil.com.br/forum/index.php?showtopic=103750 Agora vou mostrar como inserir dados na tabela do BD Bom, para ficar de facil entendimento o nome da tabela do BD será CLIENTES e os campos serão (cod, cpf, nascimento, nome, rg, endereco, telefone e celular) (lembrando que é sempre importante termos um campo código onde os valores não podem se duplicar, pois digamos que temos um cadastro e neste cadastro existem muitas pessoas com dados iguais, como nomes por exemplo, então na hora de fazermos alguma alteração teremos que nos referenciar pelo campo código que é unico) Vamos lá, Com nossa conexão já OK vamos colocar no Form em General Declarations Dim cmd As New ADODB.Command 'objeto command para trabalhar com o banco, inserindo, excluindo etc.. Dim rs As New ADODB.Recordset 'Recodset que trará valores da tabela em nossas consultas Dim vCod_cliente As Long 'variavel onde colocaremos o valor do codigo do cliente Dim vinfo As Integer 'usaremos para chamar sempre que preciso uma MsgBox vamos criar uma SUB e colocar o seguinte codigo, que fará o procedimento de verificar qual o ultimo valor do codigo inserido na tabela do BD e preparar o novo codigo para inserção de um novo registro Private Sub inserir() vinfo = MsgBox("Deseja cadastrar novo Cliente ?", vbYesNo + vbQuestion, "Cadastro de Cliente") If vinfo = vbYes Then 'se deseja gravar novo cliente então With cmd 'usando o command para retornar um dado da tabela .ActiveConnection = cnn 'indica ao command qual a conexão ativa .CommandType = adCmdText 'SQL para o commmand .CommandText = " select max(cod) as ultimocod from clientes " ' pedimos ao command que retorne o ultimo registro Set rs = .Execute 'lançamos o valor do ultimo registro no Recordset End With With rs 'procedimento com o recordset If IsNull(rs!ultimocod) Then ' se estiver nulo, ou seja, não tiver nenhum cliente cadastrado vCod_cliente = 1 'o codigo será 1, nosso primeiro cliente a ser cadastrado Else 'se não estiver nulo, ou seja, se já tiver clientes cadastrados vCod_cliente = !ultimocod + 1 ' o codigo será o ultimo acrescido de 1 End If End With End If End Sub Bom, para que esta rotina aconteça basta chama-la no click do botão que usaremos para preparar os campos para inserção de novo cadastro assim Private Sub Cmd_Inserir_Click() Inserir End Sub Ao clicarmos no botão, a rotina de inserir será criada, lançando na variável vCod_cliente o código do cliente que iremos cadastrar Agora vamos criar o procedimento que irá gravar no BD os dados do nosso cliente: Private Sub salvar() ' se a variavel não está vazia, ou seja, possui o numero do codigo do cliente If vCod_cliente <> Empty Then 'usaremos o command para retornar o campo cod e nome 'onde o campo cod seja igual ao valor que está na variavel 'para ver se será uma inclusão de novo cliente ou alteração 'do cadastro de um cliente existente With cmd .ActiveConnection = cnn 'nossa conexão .CommandType = adCmdText .CommandText = "select cod, nome from clientes where cod = " & vCod_cliente & "" Set rs = .Execute 'jogamos o resultado no Recordset End With With rs 'se não encontrou será a inclusão de novo cliente If .BOF And .EOF Then 'o command agora será usado para inserir os dados das textBox na tabela With cmd .ActiveConnection = cnn .CommandType = adCmdText .CommandText = " insert into clientes " & _ "(cod, cpf, nome, nascimento, rg, endereco, telefone, celular)values ('" & _ vCod_cliente & "','" & _ Text_cpf.Text & "','" & _ Text_nome.Text & "', '" & _ Tex_nascimento & "', '" & _ Text_Rg.Text & "','" & _ Text_Endereco.Text & "','" & _ Text_telefone.Text & "','" & _ Text_celular.Text & "');" .Execute 'este comando é que efetua a gravação dos dados informados na tabela End With 'mensagem informando a gravação dos dados do cliente vinfo = MsgBox("Cadastro efetuado com sucesso", vbOKOnly + vbInformation, "Cadastro de Clientes") 'se encontrou será uma alteração de cliente existente Else 'caixa perguntando se queremos salvar as alterações feitas no cadastro do cliente vinfo = MsgBox("Deseja salvar as alterações feitas no lançamento de " & !nome & " ?", vbYesNo + vbQuestion, "Salvar alterações") If vinfo = vbYes Then 'se sim 'aqui o command faz o update, altera os campos referente ao cliente cujo codigo é igual à variavel With cmd .ActiveConnection = cnn .CommandType = adCmdText .CommandText = " update clientes set " & _ "cpf = '" & Text_cpf.Text & "'," & _ "nome = '" & Text_nome.Text & "', " & _ "nascimento = '" & text_nascimento & "', " & _ "rg = '" & Text_Rg.Text & "'," & _ "endereco = '" & Text_Endereco.Text & "'," & _ "telefone = '" & Text_telefone.Text & "'," & _ "celular = '" & Text_celular.Text & "' where cod = " & vCod_cliente & ";" .Execute End With 'informa que foram alterados os campos do cliente que já existia vinfo = MsgBox("Alterações salvas com sucesso", vbOKOnly + vbInformation, "Salvar alterações") End If End If End With End If End Sub Para chamar esta sub é só coloca-la no botão que irá gravar os dados Private Sub Cmd_salvar_Click() Salvar End Sub

Rapa, olha só, vê se não faz sentido, primeiro você colocou o codigo que gera e abre o relatorio pra depois colocar o codigo que informa o campo da data, inverte a ordem que acho que vai ficar tudo certo Private Sub cmdRelConPData_Click() If txtDataInicial.Text = "" Then MsgBox "Preencha a Data Inicial.", vbExclamation txtDataInicial.SetFocus ElseIf txtDataFinal.Text = "" Then MsgBox "Preencha a Data Final.", vbExclamation txtDataFinal.SetFocus Else Dim Conex As New ADODB.Connection Conex.Open StringDeConexao With cmd_relatorio .ActiveConnection = Conex .CommandType = adCmdText .CommandText = "SELECT * FROM FinanWin_Contas WHERE isNull(Con_ValorPgtoCP) AND Con_Tipo = 'CP' AND Con_Venc BETWEEN #" & txtDataInicial & "# AND #" & txtDataFinal & "# ORDER BY Con_Venc" Set rs_relatorio = .Execute End With Dim DInicial As Date Dim DFinal As Date DInicial = txtDataInicial.Text DFinal = txtDataFinal.Text rptConPData.Sections("Section2").Controls("lblPeriodo").Caption = "Período de Referência: " & Format(DInicial, "DD/MM/YYYY") & " a " & Format(DFinal, "DD/MM/YYYY") With rptConPData Set .DataSource = rs_relatorio .DataMember = "" .Refresh .Show End With End If End Sub

Manda o codigo completo do relatorio

então faz uma soma para quando o campo tipo for CP e outra para quando o campo tipo for CR Select sum(valor) as total_CP from tabela where tipo = CP Select sum(valor) as Total_CR from tabela where tipo = CR ai você terá duas somas distintas, uma somara o todos os registros do campo VALOR quando o campo TIPO estiver CR e outra somara os registros do campo VALOR quando o campo TIPO for CP

Obrigado pela aula Denys.

Beleza camaradas, obrigado mais uma vez.

Posta teu codigo, e se você criar direto pelo prompt ? não serve?

Qual tipo de campo devo usar para guardar valores monetarios no MySQl ? utilizei o campo DECIMAL, mas ele não salva justamente os décimos! redundante né? quando insiro o valor 120,53 ele salva 121 sem as casas decimais, sempre arredonda, estou usando o tipo de campo errado ou tenho que acrescentar algo no campo para que ele não arredonde ? ou será que pode existir também algo tipo, informar ao campo quantas casas decimais ? Obs: ele também só aceitou inserir valor no campo quando troquei a "," por "." usando replace.

Pessoal, estou precisando de uns toques em relação a qual tipo adequado de campos devo usar, por exemplo: para datas, esse é facil de saber (DATE) para textos pequenos, como nomes (VARCHAR) podendo escolher o tamanho certo? mas os campos que não sei, ou tenho duvida: Para valor monetário = ? Para textos longos, bem longos, como corpo de cartas (como o campo MEMO do Access) = ? Para numeros inteiros que podem ter até digamos oito casas assim: 99999999 = ? Agradeço desde já a atenção de todos.