frata

Private Sub Form_Load() If Time > #05:00:00 PM# Then MsgBox "Este terminal está programado para desligar após às 5 horas", , "" Shell "shutdown -r -t 00"

Descobri sozinho como resolver o problema. É simples! Basta abrir a versão antiga e exportar o Userform; em seguida abra a versão superior e importe o Userfor. Sempre usando a interface do VBA.

Prezados colegas: Fiz uma planilha em excel 2000 que usa alguns códigos VBA e dois Useforms. Porém quando rodo a planilha numa versão superior os useforms não aparecem. Será um problema de compatibilidade? Fico no aguardo. Obrigado!

Obrigado! Ajudou sim!! Valeu!!!!

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!!

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!!

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.

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

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

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

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

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...!!!

Prezados colegas: Estou precisando com urgência desenvolver uma planilha que use um formulário com filtro; no caso seriam dois formulários, um para cadastro e outro para consultas. Já desenvolvi diversas mas elas não funcionam corretamente. Será que alguém sabe onde posso baixar uma pronta e fazer algumas modificações ? A planilha seria para cadastrar clientes aqui na empresa e Preciso apresentar esse trabalho pronto. Obrigado a todos os colegas do Forum. Frata

Prezados colegas: Desenvolvi uma planilha bastante interessante, onde possui um formulário para cadastrar dados e outro que filtra os dados. Sendo que este segundo formulário de filtros ao ser aberto dá a opção de aparecer todos os cadastros do banco, e então ao clicar num cadastro ele abre os dados para verificação, alterações ou consultas. Acontece que se não estiver preenchido todos os campos disponíveis no formulário ele não carrega os dados solicitados. http://www.carlinsplasticos.com.br/banco.xls No endereço abaixo é possível baixar a planilha para verificar. A planilha que contém os dados está oculta. Um grande abraço a todos. Frata.

Prezados colegas; Já faz algum tempo que não venho por aqui; bem. estou desenvolvendo uma pequena aplicação para baixar vídeos do Youtube.com; até aí tudo bem; acontece que o meu programa é na realidade um navegador em VB 6.0 que abre sempre a página do You tube. Então vem a parte que não estou sabendo desenvolver, porque preciso que no próprio navegador (desenvolvido em VB 6.0); onde aparecer o link do Vídeo tipo: http://www.youtube.com/watch?v=zJYIw2A3YjI o nome youtube seja trocado por: voobys ficando assim: http://www.voobys.com/watch?v=zJYIw2A3YjI Mas para ter maior funcionalidade, essa troca de nome teria que ser quando o usuário clicar num determinado botão do meu navegador. Será que deu para entender ou ficou confuso. Antecipadamente agradeço aos colegas do Forum, e quero deixar patente aqui que é um enorme prazer estar de volta, porque aqui aprendi muito e, com a ajuda deste Forum, desenvolvi coisas realmente interessantes. Obrigado a todos. Frata.

Oi kuroi: A princípio seria instalado pelo CD, e o objetivo desse recurso seria evitar que o usuário copiasse o programa e o instalasse em outras máquinas. Seria uma proteção contra Pirataria. Vou dar uma olhada no link que você indicou. Obrigado. Aceito sugestões, porque nem sei se realmente o que estou pensando (de ler o número do HD) seria realmente a melhor idéia. Obrigado e grande abraço. Frata.

Prezado Danleonhart: Funcionou PERFEITAMENTE, muito obrigado pela gentileza. Grande abraço Frata.

Bem pessoal, por questões de segurança preciso descobrir a maneira de que o meu programa ao ser instalado leia o número de série da máquina e assim não aceite mais ser instalado em outro computador. Será que isso é muito difícil de implementar? Agradeço antecipadamente aos colegas do Forum, por mais essa dica. Grande abraço a todos Frata.

Valeu...!!! Brigadoooooooo! Frata.