frata

Membros
  • Content Count

    152
  • Joined

  • Last visited

Community Reputation

0 Neutro

About frata

Recent Profile Visitors

1374 profile views
  1. Obrigado! Ajudou sim!! Valeu!!!!
  2. caros colegas! Preciso de um código com o qual eu dou um clique duplo na linha do listview e abra meu formulário com os dados desa linha carregados. Será que alguém sabe como faço isso? Obrigado!!
  3. frata

    Timer no VBA

    Bom dia, galera!!! Preciso colocar um Timer num formulário VBA para ele abrir por um período de 2 segundos. Em VB é muito fácil criar isso, mas descobri que o VBA não tem o Timer. Será que dá para criar isso com um código?? Obrigado!!
  4. Grande Kuroi:

    Você já me salvou diversas vezes, e pode me salvar mais uma vez. Tenho o código abaixo que abre uma determinada pasta no Windows; até aí tudo bem, mas preciso de um código para depois fechar essa mesma página. HELP!!! Obrigado, uma vez mais. Grande abraço.

    Shell "explorer /n,C:\MinhaPasta", vbNormalFocus

  5. Prezados colegas: Preciso de um código que feche uma pasta específica do Windows. Eu dou o caminho e se a pasta estiver aberta ela será fechada via código. Será que alguém sabe como desenvolver isso??? Antecipadamente agradeço a todos. Grande abraço. Frata.
  6. Prezado Kuroi, boa noite!

    Como você já me "salvou" diversas vezes, é que resolvi te pedir um socorro novamente. Abaixo estou enviando um código que era de um cadastro de receitas de culinária, e eu estou adaptando-o para cadastro de clientes. O que acontece? O programa anterior não aceita campos nulos, mas o atual, por ser um cadastro deve aceitar campos nulos. Gostaria de saber como modifico isso. O banco que estou usando é um Access. Antecipadamente agradeço pela sua atenção e gentileza. Frata.

    Ah, só mais uma coisinha, eu até modifiquei a parte do código que avisa que existem campos vazios, mas aí dá erro quando vai salvar. Brigaduuuuuuuuu..!!!

     

     

    'declarando os objetos necessários
    'command e recordset para interagir com o  BD
    'e declarando variavel para utilizar msgbox
    Dim cmd As New ADODB.Command
    Dim rs As New ADODB.Recordset
    Dim vinfo As Integer
    'chamando a sub que carrega a lista com os dados do BD
    Private Sub Form_Load()
    preenche_list

    End Sub

    'descarregando os objetos command e recordset quando
    'fechar o form e limpando os arquivos temp criados
    Private Sub Form_Unload(Cancel As Integer)
    Set cmd = Nothing
    Set rs = Nothing
    Set cnnreceitas = Nothing

    If Dir("c:*.tmp") <> "" Then
    On Error Resume Next
    Kill "c:*.tmp"
    End If

    End Sub

    'quando der duplo click na lista
    'filtra as informações no BD e joga nos campos
    'para alterar
    Private Sub List_receitas_DblClick()
    With cmd
        .ActiveConnection = cnnreceitas
        .CommandType = adCmdText
        .CommandText = "select * from receitas"
    Set rs = .Execute
    End With
    With rs
        .Filter = " receita like '" & List_receitas.Text & "'"
        Frame_cadastro.Visible = True
        Frame_Localizar.Visible = False
        Toolbar1.Visible = False
        Toolbar2.Visible = True
        travar_campos
        Text_cod = !cod
        Text_receita = !receita
        Text_ingredientes = !ingredientes
        Text_preparo = !preparo
        Text_email = !email
    End With
    End Sub

    'codigo que faz a busca na List quando é digitado
    'na text
    Private Sub Text1_Change()
    On Error GoTo trataerro

    With cmd
        .ActiveConnection = cnnreceitas
        .CommandType = adCmdText
        .CommandText = "select * from receitas"
        Set rs = .Execute
    End With
    With rs
        .Filter = " receita like '%" & Text1.Text & "%'"
        If .BOF And .EOF Then
        MsgBox ("Sequencia de caracteres não encontrado na lista")
        Else
        List_receitas = rs!receita
        End If
    End With

    trataerro:

    With Err
    If .Number <> 0 Then
    .Number = 0

    End If
    End With

    End Sub

    'faz as alterações entre as toolbar e os frames
    Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
        Case 1
        Toolbar1.Visible = False
        Toolbar2.Visible = True
        Frame_cadastro.Visible = True
        Frame_Localizar.Visible = False
        Case 2
        Frame_Localizar.Visible = True
        Text1.Text = ""
        
        
    End Select
    End Sub

    'chama os procedimentos de gravar, inserir ou retornar
    'para o outro frame
    Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
    Report

  • frata

    Null

    Prezados colegas: Segue abaixo um código que quando vai salvar no banco de dados um Access ele pede que todos os campos do formulário estejam preenchidos. Será que alguém sabe como modificar isso. Obrigado! 'declarando os objetos necessários 'command e recordset para interagir com o BD 'e declarando variavel para utilizar msgbox Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset Dim vinfo As Integer 'chamando a sub que carrega a lista com os dados do BD Private Sub Form_Load() preenche_list End Sub 'descarregando os objetos command e recordset quando 'fechar o form e limpando os arquivos temp criados Private Sub Form_Unload(Cancel As Integer) Set cmd = Nothing Set rs = Nothing Set cnnreceitas = Nothing If Dir("c:*.tmp") <> "" Then On Error Resume Next Kill "c:*.tmp" End If End Sub 'quando der duplo click na lista 'filtra as informações no BD e joga nos campos 'para alterar Private Sub List_receitas_DblClick() With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With With rs .Filter = " receita like '" & List_receitas.Text & "'" Frame_cadastro.Visible = True Frame_Localizar.Visible = False Toolbar1.Visible = False Toolbar2.Visible = True travar_campos Text_cod = !cod Text_receita = !receita Text_ingredientes = !ingredientes Text_preparo = !preparo Text_email = !email End With End Sub 'codigo que faz a busca na List quando é digitado 'na text Private Sub Text1_Change() On Error GoTo trataerro With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With With rs .Filter = " receita like '%" & Text1.Text & "%'" If .BOF And .EOF Then MsgBox ("Sequencia de caracteres não encontrado na lista") Else List_receitas = rs!receita End If End With trataerro: With Err If .Number <> 0 Then .Number = 0 End If End With End Sub 'faz as alterações entre as toolbar e os frames Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1 Toolbar1.Visible = False Toolbar2.Visible = True Frame_cadastro.Visible = True Frame_Localizar.Visible = False Case 2 Frame_Localizar.Visible = True Text1.Text = "" End Select End Sub 'chama os procedimentos de gravar, inserir ou retornar 'para o outro frame Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1 NOVO Case 2 Gravar Case 3 If Text_cod.Text <> "" Then liberar_campos Else MsgBox ("Escolha uma receita na lista através do menu Localizar, dê duplo click na receita a ser alterada") End If Case 4 excluir Case 5 Toolbar2.Visible = False Toolbar1.Visible = True Frame_cadastro.Visible = False limpar_campos preenche_list End Select End Sub 'subprocedimento que prepara a inserção de um novo 'registro no BD Private Sub NOVO() vinfo = MsgBox("Deseja inserir nova receita no Livro de Receitas ?", vbYesNo + vbQuestion, "Nova receita") If vinfo = vbYes Then With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select max(cod) as Mcod from receitas" Set rs = .Execute End With With rs If IsNull(rs!Mcod) Then Text_cod.Text = 1 Else limpar_campos preenche_list Text_cod.Text = !Mcod + 1 End If End With Text_receita.Locked = False Text_ingredientes.Locked = False Text_preparo.Locked = False Text_email.Locked = False Text_receita.SetFocus End If End Sub 'subprocedimento para gravar um registro novo 'ou alterar um registro existente Private Sub Gravar() 'se houver campos em branco informa ao usuario If Text_receita.Text = "" Or _ Text_ingredientes.Text = "" Or _ Text_preparo.Text = "" Then MsgBox ("Existe(m) campo(s) em branco, verifique") Else 'se não, faz a busca no BD With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With With rs .Filter = "cod = " & Text_cod.Text & " " If .BOF And .EOF Then 'se não achar identifica 'como inclusão With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "insert into receitas" & _ "(cod,email, receita, ingredientes, preparo)values('" & _ Text_cod.Text & "','" & _ Text_email & "','" & _ Text_receita & "','" & _ Text_ingredientes.Text & "','" & _ Text_preparo.Text & "');" .Execute 'grava vinfo = MsgBox("Receita salva com sucesso!", vbOKOnly, "Salvar receita") limpar_campos travar_campos preenche_list End With Else 'se achar o registro identifica como alteração With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = " update receitas set " & _ "receita = '" & Text_receita.Text & "'," & _ "email = '" & Text_email.Text & "'," & _ "ingredientes = '" & Text_ingredientes.Text & "'," & _ "preparo = '" & Text_preparo.Text & "'" & _ "where cod = " & Text_cod.Text & ";" .Execute vok = MsgBox("Alterações salvas com sucesso!", vbOKOnly, "Alterar receita") limpar_campos travar_campos preenche_list End With End If End With End If End Sub 'subprocedimento que carrega a lista com os registros 'do BD quando executado no evento Load do Form Private Sub preenche_list() With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With Do While Not rs.EOF If Not IsNull(rs!receita) Then List_receitas.AddItem rs!receita End If rs.MoveNext Loop End Sub 'subprocedimento que quando chamado limpa os controles 'do form Private Sub limpar_campos() Text_receita.Text = "" Text_email.Text = "" Text_ingredientes.Text = "" Text_preparo.Text = "" Text_cod.Text = "" List_receitas.Clear End Sub 'subprocedimento que trava os textbox Private Sub travar_campos() Text_receita.Locked = True Text_ingredientes.Locked = True Text_preparo.Locked = True Text_email.Locked = True End Sub 'subprocedimento que destrava os textbox Private Sub liberar_campos() Text_receita.Locked = False Text_ingredientes.Locked = False Text_preparo.Locked = False Text_email.Locked = False End Sub 'subprocedimento que faz a exclusão de um registro 'no BD Private Sub excluir() 'se o campo com o numero do codigo estiver em branco 'não executa nada If Text_cod.Text = "" Then MsgBox ("Não existe receita para exclusão, verifique.") Else 'se não estiver em branco solicita a confirmação 'de exclusão do registro vinfo = MsgBox("Deseja excluir esta receita ?", vbYesNo + vbQuestion, "Excluir receita") If vinfo = vbYes Then 'se confirmado então exclui With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = " delete from receitas where cod = " & Text_cod.Text & ";" .Execute End With End If limpar_campos 'limpa os campos preenche_list 'preenche a lista novamente End If End Sub
  • frata

    Campos nulos

    Prezados colegas. Estou tentando adaptar um código, de cadastro de receitas para cadastro de clientes, e decorre que no código anterior não aceita campos nulos para serem inseridos no BD, mas no programa atual de clientes, é necessário que apenas os dois primeiros campos não possam ser nulos, que seriam "nome" e "endereço". Será que alguém sabe como resolver isso. Antecipadamente agradeço. Frata Estou postando o código abaixo. 'declarando os objetos necessários 'command e recordset para interagir com o BD 'e declarando variavel para utilizar msgbox Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset Dim vinfo As Integer 'chamando a sub que carrega a lista com os dados do BD Private Sub Form_Load() preenche_list End Sub 'descarregando os objetos command e recordset quando 'fechar o form e limpando os arquivos temp criados Private Sub Form_Unload(Cancel As Integer) Set cmd = Nothing Set rs = Nothing Set cnnreceitas = Nothing If Dir("c:*.tmp") <> "" Then On Error Resume Next Kill "c:*.tmp" End If End Sub 'quando der duplo click na lista 'filtra as informações no BD e joga nos campos 'para alterar Private Sub List_receitas_DblClick() With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With With rs .Filter = " receita like '" & List_receitas.Text & "'" Frame_cadastro.Visible = True Frame_Localizar.Visible = False Toolbar1.Visible = False Toolbar2.Visible = True travar_campos Text_cod = !cod Text_receita = !receita Text_ingredientes = !ingredientes Text_preparo = !preparo Text_email = !email End With End Sub 'codigo que faz a busca na List quando é digitado 'na text Private Sub Text1_Change() On Error GoTo trataerro With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With With rs .Filter = " receita like '%" & Text1.Text & "%'" If .BOF And .EOF Then MsgBox ("Sequencia de caracteres não encontrado na lista") Else List_receitas = rs!receita End If End With trataerro: With Err If .Number <> 0 Then .Number = 0 End If End With End Sub 'faz as alterações entre as toolbar e os frames Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1 Toolbar1.Visible = False Toolbar2.Visible = True Frame_cadastro.Visible = True Frame_Localizar.Visible = False Case 2 Frame_Localizar.Visible = True Text1.Text = "" End Select End Sub 'chama os procedimentos de gravar, inserir ou retornar 'para o outro frame Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1 NOVO Case 2 Gravar Case 3 If Text_cod.Text <> "" Then liberar_campos Else MsgBox ("Escolha uma receita na lista através do menu Localizar, dê duplo click na receita a ser alterada") End If Case 4 excluir Case 5 Toolbar2.Visible = False Toolbar1.Visible = True Frame_cadastro.Visible = False limpar_campos preenche_list End Select End Sub 'subprocedimento que prepara a inserção de um novo 'registro no BD Private Sub NOVO() vinfo = MsgBox("Deseja inserir nova receita no Livro de Receitas ?", vbYesNo + vbQuestion, "Nova receita") If vinfo = vbYes Then With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select max(cod) as Mcod from receitas" Set rs = .Execute End With With rs If IsNull(rs!Mcod) Then Text_cod.Text = 1 Else limpar_campos preenche_list Text_cod.Text = !Mcod + 1 End If End With Text_receita.Locked = False Text_ingredientes.Locked = False Text_preparo.Locked = False Text_email.Locked = False Text_receita.SetFocus End If End Sub 'subprocedimento para gravar um registro novo 'ou alterar um registro existente Private Sub Gravar() 'se houver campos em branco informa ao usuario If Text_receita.Text = "" Or _ Text_ingredientes.Text = "" Or _ Text_preparo.Text = "" Then MsgBox ("Existe(m) campo(s) em branco, verifique") Else 'se não, faz a busca no BD With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With With rs .Filter = "cod = " & Text_cod.Text & " " If .BOF And .EOF Then 'se não achar identifica 'como inclusão With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "insert into receitas" & _ "(cod,email, receita, ingredientes, preparo)values('" & _ Text_cod.Text & "','" & _ Text_email & "','" & _ Text_receita & "','" & _ Text_ingredientes.Text & "','" & _ Text_preparo.Text & "');" .Execute 'grava vinfo = MsgBox("Receita salva com sucesso!", vbOKOnly, "Salvar receita") limpar_campos travar_campos preenche_list End With Else 'se achar o registro identifica como alteração With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = " update receitas set " & _ "receita = '" & Text_receita.Text & "'," & _ "email = '" & Text_email.Text & "'," & _ "ingredientes = '" & Text_ingredientes.Text & "'," & _ "preparo = '" & Text_preparo.Text & "'" & _ "where cod = " & Text_cod.Text & ";" .Execute vok = MsgBox("Alterações salvas com sucesso!", vbOKOnly, "Alterar receita") limpar_campos travar_campos preenche_list End With End If End With End If End Sub 'subprocedimento que carrega a lista com os registros 'do BD quando executado no evento Load do Form Private Sub preenche_list() With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = "select * from receitas" Set rs = .Execute End With Do While Not rs.EOF If Not IsNull(rs!receita) Then List_receitas.AddItem rs!receita End If rs.MoveNext Loop End Sub 'subprocedimento que quando chamado limpa os controles 'do form Private Sub limpar_campos() Text_receita.Text = "" Text_email.Text = "" Text_ingredientes.Text = "" Text_preparo.Text = "" Text_cod.Text = "" List_receitas.Clear End Sub 'subprocedimento que trava os textbox Private Sub travar_campos() Text_receita.Locked = True Text_ingredientes.Locked = True Text_preparo.Locked = True Text_email.Locked = True End Sub 'subprocedimento que destrava os textbox Private Sub liberar_campos() Text_receita.Locked = False Text_ingredientes.Locked = False Text_preparo.Locked = False Text_email.Locked = False End Sub 'subprocedimento que faz a exclusão de um registro 'no BD Private Sub excluir() 'se o campo com o numero do codigo estiver em branco 'não executa nada If Text_cod.Text = "" Then MsgBox ("Não existe receita para exclusão, verifique.") Else 'se não estiver em branco solicita a confirmação 'de exclusão do registro vinfo = MsgBox("Deseja excluir esta receita ?", vbYesNo + vbQuestion, "Excluir receita") If vinfo = vbYes Then 'se confirmado então exclui With cmd .ActiveConnection = cnnreceitas .CommandType = adCmdText .CommandText = " delete from receitas where cod = " & Text_cod.Text & ";" .Execute End With End If limpar_campos 'limpa os campos preenche_list 'preenche a lista novamente End If End Sub
  • frata

    Formulário

    Prezados colegas: Estou precisando que o meu formulário ao abrir fique posicionado em cima do relógio do windows; eu já fiz isso uma vez, mas não lembro mais como desenvolver esse código. Será que alguém poderia me dar uma dica? Antecipadamente agradeço pela atenção e gentileza de todos. Frata
  • frata

    Abrindo PDF

    Prezados colegas: Desenvolvi um navegador que funciona perfeitamente bem. Porem descobri que se a página que estou navegando for um PDF ela só abre se na máquina eu tiver instalado o Adove Reader na versão 10.0.0 já verifiquei que em máquinas onde está instalada a versão 10.1.9 do Adove Rider, a página não carrega. Será que alguém sabe me dizer porque isso ocorre? Não posso solicitar que os usuários atualizem o Adove para baixo. Segue abaixo o código que estou usando: If Form1.Text1 = "15414.002878/2012-37" Then Form3.Show Form3.WebBrowser1.Navigate "http://www.sulamerica.com.br/capitalizacao/cgs/CG_15414_001368_2012_42_adap46012.pdf" Unload Me Estou usando o componente WebBrowser. Abraço a todos. Frata
  • Desenvolvi um navegador que funciona muito bem. Porém agora, descobri por acaso, que ele não abre páginas com PDF, ou melhor até abre, mas só se na máquina estiver instalado o Adobe na versão 10.0.0; nas máquina com a versão 10.1.3 a página com extensão PDF não abre e ainda dá erro. E o pior é que não posso mandar o usuário atualizar para baixo. Será que alguém tem alguma coisa a dizer em relação a esse mistério..???? Segue abaixo o código: Obs.: estou usando o componente WebBrowser. Form1.Show Form1.wbrDesiredURL.Navigate "http://www.sulamerica.com.br/capitalizacao/cgs/CG_15414_001277_2012_15_adap46012.pdf" Form6.Show Unload Me
  • Oi, Obrigado pelo seu comentário, mas acho que me expressei mal. Este código é para abrir endereços da web e não na minha máquina, e aliás funciona muito bem; menos para PDF. Hoje descobri por acaso que é necesário que se tenha na máquina o Adobe versão 10.0.0 e nas versõe acima desta não abre. Isso é, na realidad, um complicador porque não posso mandar o usuário atualizar para baixo. Será que existe alguma outra solução? Obrigado. Frata.
  • Prezados colegas: Desenvolvi um navegador em vb que funciona muito bem, acontece que descobri que ele não abre páginas com extensão PDF; inclusive dá erro. Estou usando o o VB numa versão express. Abaixo segue o código. Antecipadamente agradeço se alguém puder me ajudar. Obrigado. Frata Form1.Show Form1.wbrDesiredURL.Navigate http://carlinsplasticos.com.br/ Form6.Show Unload Me
  • frata

    Formulário

    Prezados colegas: Uma vez mais recorro aos senhores para me tirarem uma dúvida. Preciso que o formulário role usando uma barra de rolagem e exiba uma figura. Acontece que a rolagem máxima não é suficiente para exibir toda a imagem e fica faltando mostrar o finalzinho da mesma. Não sei como fazer para que role e mostra a imagem toda. Abaixo segue o código que estou usando. Obrigado a todos. Frata. Option Explicit Dim PosAnterior As Integer Private Sub cmdQuit_Click() Unload Me End Sub Private Sub Form_Load() Dim iAlturaFormulario As Integer Dim iExibeAltura As Integer iAlturaFormulario = 32000 iExibeAltura = 5800 Me.Height = iExibeAltura With VScroll1 .Height = Me.ScaleHeight .Min = 0 .Max = iAlturaFormulario - iExibeAltura .SmallChange = Screen.TwipsPerPixelY * 800 .LargeChange = .SmallChange End With End Sub Private Sub pRolaFormulario() Dim ctl As Control For Each ctl In Me.Controls If Not (TypeOf ctl Is VScrollBar) And Not (TypeOf ctl Is CommandButton) Then ctl.Top = ctl.Top + PosAnterior - VScroll1.Value End If Next PosAnterior = VScroll1.Value End Sub Private Sub VScroll1_Change() Call pRolaFormulario End Sub Private Sub VScroll1_Scroll() Call pRolaFormulario End Sub
  • Prezados colegas: Fiquei bastante tempo sem postar nada; mas foi por pura falta de tempo. Agora retorno com uma pequena dúvida; que é a seguinte: Estou desenvolvendo uma pequena aplicação, onde preciso que o objeto label tenha a seguinte formatação: 45.000,0000 - ou seja, separadores de milhar e quatro casas decimais. Já tentei usar o dataFormat da Label, mas não funciona.... será que tem algo que ver com o tipo de variável..??? Coloco abaixo um exemplo do código que estou usando. Antecipadamente agradeço a todos. É um prazer estar de volta..!!! Private Sub Command1_Click() Dim valor As String valor = Text1 Label1 = valor * 8000 End Sub Oi....acabei de descobrir sozinho, observando o DataFormat; vou postar aqui porque pode ser útil para alguém; o código é o seguinte: Label1=Format$(Label1,"#,####0.0000;(#,####0.0000)") Funcionou super bem...!!!