VAMOS AO LOOP NO VB.

USUARIO.EXCLUIDOS 04/06/2007 14:48:01
#219649
Existe um campo data em meu sistema que ele informa quando a data for invalida ,porém gostaria de adicionar um loop para não deixar ele sair enquanto a data for errada.

O detalhe e como e um loop no VB ? ja fiz isso em portugues estruturado ,alguem pode me dar um exemplo ?

-Campo Data-

Private Sub tb_dt_KeyPress(KeyAscii As Integer)
'Funcao- Quando chegar no 10 digito ,mudara de campo
If tb_dt.SelStart = 9 Then
   SendKeys "{TAB}"
   
 End If

End Sub


-Função Checa_Data-

Function Fu_Checa_Data(data$)
'Verifica se a data e valida
   Fu_Checa_Data = True


   If Not IsDate(data$) Then
      Fu_Checa_Data = False
   ElseIf Val(Mid(data$, 4, 2)) > 12 Then
      Fu_Checa_Data = False
   End If
   
End Function
USUARIO.EXCLUIDOS 04/06/2007 15:21:53
#219663
E uma ajuda para conseguir dar um loop no VB6 ,enquanto a data nao for informada correto ,ficara dando um loop ate a data ser digitada certa.
USUARIO.EXCLUIDOS 04/06/2007 15:41:37
#219673
Bom, se o usuário persistir em digitar a data errada, sua função vai acusar até ele arrumar...mais se vc quiser informar uma data válida com base na data que ele digitou existe a função DateAdd()

DateAdd(onde será adicionado e: "d" = dia, "m" = mês, "y" = ano, nro a ser adicionado 1,2,-1,data)

segue um exemplo completo:

DateAdd("m",1,"01/01/2007") ele retorna = "01/02/2007"
DateAdd("d",1,"01/01/2007") ele retorna = "02/01/2007"

espero ter ajudado...
USUARIO.EXCLUIDOS 04/06/2007 15:43:43
#219675 Resposta escolhida
No evento Lost_Focus do seu TextBox vc faz a chamada da sua função Fu_Checa_Data(data$): exemplo:

Private Sub TextBox1_LostFocus()

  if Fu_Checa_data(TextBox1.Text)=false then 
     TextBox1.setfocus
  end if

End Sub
USUARIO.EXCLUIDOS 04/06/2007 15:53:40
#219678
Frau

Não entendi muito bem.

No meu lost_Focus ja tem uma função ,mas como que eu aplico essa adicional ?


E ALETERLONE nesse caso quero acusar a data ate o usuario arrumar ,porque as datas aqui são bem completas.

Tentei entender mas nao consegui aplicar ainda
JB207 04/06/2007 16:02:45
#219681
Eu faço assim:

1 - Não deixo digitar nada no campo a não ser numeros
2 - No evento LostFocus do campos eu vou verificar
Se é Valor = "V", Percentual= "P" ou data = "D"
3 - Faço as formatações dos campos e passo pra checagem.
4 - Quando se trata de data e for digitado alguma coisa somente passará para o proximo campo se for uma data válida.
5 - Minha formatacao e checagem das data esta num módulo a parte que esta indo junto aqui.
Espero que ajude.


If Mid(txtCampo(Index).Tag, 1, 1) = "N" Then
If Mid(txtCampo(Index).Tag, 2, 1) = "V" Or Mid(txtCampo(Index).Tag, 2, 1) = "P" Then
If Len(Trim(txtCampo(Index).Text)) > 0 Then
txtCampo(Index).Text = Format(txtCampo(Index).Text, "###,###,##0.00")
Else
txtCampo(Index).Text = Format("0,00", "###,###,##0.00")
End If
Else
If Mid(txtCampo(Index).Tag, 2, 1) = "D" Then
If Len(txtCampo(Index).Text) <> 0 Then
If Muda_Texto_Data(txtCampo(Index).Text) = False Then
Mensagem = "Data com formato inválido. Informe (99/99/9999) ou (99999999)"
Excl_Regi = False
frmMsgBox.txtMensagem.Text = Mensagem
frmMsgBox.Show vbModal
txtCampo(Index).SetFocus
Exit Sub
Else
txtCampo(Index).Text = RetornoData
End If
End If
End If
End If
End If



' Variaveis de definicao das Datas

'' Variável de Data
Public Data As Date
Public RetornoData As Date
Public Resultado As String
Public Caracter As String
Public NumeroBarras As Integer
Public DataAuxiliar As String

Public Function Muda_Texto_Data(Data_Info As String) As Boolean
    
    If Data_Info = "" Then Exit Function
    
    Muda_Texto_Data = False
    
    Caracter = ""
    NumeroBarras = 0
    
    If Len(Data_Info) < 8 Then
        Exit Function
    End If
    
    For Contador = 1 To Len(Data_Info)
        Caracter = Mid(Data_Info, Contador, 1)
        If Caracter = "/" Then
            NumeroBarras = NumeroBarras + 1
        End If
    Next
    
    If NumeroBarras = 0 And Len(Data_Info) = 8 Then
        DataAuxiliar = Mid(Data_Info, 1, 2) & "/" & Mid(Data_Info, 3, 2) & "/" & Mid(Data_Info, 5, 4)
        Data_Info = DataAuxiliar
        NumeroBarras = 2
    End If
    
    If NumeroBarras <> 2 Then
        Exit Function
    End If
    
    If Not IsDate(Data_Info) Then
        Exit Function
    End If
    
    RetornoData = Data_Info
    Muda_Texto_Data = True
    
End Function


Public Function Diferenca_Datas(DataInicial As Date, DataFinal As Date) As Long

    Dim AnoInic         As Integer
    Dim MesInic         As Integer
    Dim DiaInic         As Integer
    
    Dim AnoFina         As Integer
    Dim MesFina         As Integer
    Dim DiaFina         As Integer

    Dim LoopAnos        As Long
    Dim LoopMese        As Long
    Dim LoopDias        As Long
    
    Dim SomaAnos        As Long
    Dim SomaMese        As Long
    Dim SomaDias        As Long
    
    AnoInic = Year(DataInicial)
    MesInic = Month(DataInicial)
    DiaInic = Day(DataInicial)

    AnoFina = Year(DataFinal)
    MesFina = Month(DataFinal)
    DiaFina = Day(DataFinal)

    Diferenca_Datas = 0
    SomaAnos = 0
    SomaMese = 0
    SomaDias = 0
    
    If AnoInic = AnoFina Then
        SomaDias = DateDiff("D", DataInicial, DataFinal)
        Diferenca_Datas = SomaDias
        Exit Function
    End If
    
    SomaAnos = DateDiff("YYYY", DataInicial, DataFinal)
    Diferenca_Datas = SomaAnos

End Function


Function CalculaIdade(DataNasc As Date)

    If IsNull(DataNasc) Or DataNasc > Date Then
        Mensagem = "Data de Nascimento Inválida!"
        Mensagem = MsgBox(Mensagem, vbExclamation + vbOKOnly, CabMens)
        Exit Function
    End If
    
    Dim Anos, Meses, Dias
    Dim Ianos As Double, Imeses As Double, Intervalo As Double

' O resultado da diferença está em Double
    Intervalo = Date - DataNasc

' Um ano tem exatamente 365,25 dias
    Ianos = Intervalo / 365.25
    Anos = Int(Ianos)
    Imeses = (Ianos - Anos) * 12
    Meses = Int(Imeses)

    Dias = DateDiff("d", DateSerial(DatePart("yyyy", DataNasc) + Anos, DatePart("m", DataNasc) + Meses, Day(DataNasc)), Date)

    If Dias = 30 Then
        Dias = 0
        Meses = Meses + 1
    End If

    If Meses = 12 Then
        Meses = 0
        Anos = Anos + 1
    End If

Fim:
    If Anos > 1 Then
        Anos = Anos & " anos "
    Else
        Anos = Anos & " ano "
    End If

    If Meses > 1 Then
        Meses = Meses & " meses "
    Else
        Meses = Meses & " mês "
    End If

    If Dias > 1 Then
        Dias = Dias & " dias"
    Else
        Dias = Dias & " dia"
    End If

    CalculaIdade = Anos & Meses & Dias
    
End Function
USUARIO.EXCLUIDOS 04/06/2007 16:09:33
#219684
Bom para validar a data e nao deixar sair do campo eu uso assim:
No evento validate coloque o seguinte codigo:

 If IsDate(txt_Seu_Campo.Text) = True Then
Cancel = False
Else
Cancel = True
MsgBox "Digite uma data Válida!", vbInformation, "Valide a data!"
End If

USUARIO.EXCLUIDOS 04/06/2007 16:36:52
#219692
LUCASERODRIGUES
Gostei muito dessa sua solução simples e eficaz pelo jeito ,porem como sou novato ,alias muito novato ,estou meio perdido onde aplicar esse codigo.

Olha os campos abaixo sobre data.



-Campo Data-


Private Sub tb_dt_KeyPress(KeyAscii As Integer)
'Funcao- Quando chegar no 10 digito ,mudara de campo
If tb_dt.SelStart = 9 Then
   SendKeys "{TAB}"
   
 End If

End Sub



"Module1.bas"-Função Checa_Data-


Function Fu_Checa_Data(data$)
'Verifica se a data e valida
   Fu_Checa_Data = True


   If Not IsDate(data$) Then
      Fu_Checa_Data = False
   ElseIf Val(Mid(data$, 4, 2)) > 12 Then
      Fu_Checa_Data = False
   End If
   
End Function
JB207 04/06/2007 16:54:07
#219698
Brother.....ja que voce é iniciante iniciantíssimo, usa o que o Frau indicou.
Citação:


No evento Lost_Focus do seu TextBox vc faz a chamada da sua função Fu_Checa_Data(data$): exemplo:

Private Sub TextBox1_LostFocus()

  if Fu_Checa_data(TextBox1.Text)=false then
     TextBox1.setfocus
  end if

End Sub





Abraços.
USUARIO.EXCLUIDOS 04/06/2007 19:00:58
#219718
Citação:

Não entendi muito bem.

No meu lost_Focus ja tem uma função ,mas como que eu aplico essa adicional ?

Vc vai colocar exatamente o código que postei...se tiver alguma coisa lá apaga...Pode fazer o teste que funfa...



Private Sub TextBox1_LostFocus()

  if Fu_Checa_data(TextBox1.Text)=false then 
     TextBox1.setfocus
  end if

End Sub


SÓ COPIAR/COLAR E TESTAR...
USUARIO.EXCLUIDOS 05/06/2007 09:01:13
#219772
Cara vou testar.
Página 1 de 3 [23 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar