TESTANDO ANO

IRENKO 11/12/2006 10:55:52
#189247
Na linha abaixo testo o ano de uma data digitada em um textbox ex:

23/12/2006

Se digito 23/12/06 retorna uma mensagem para verificar o ano. Gostaria de adapta-la para aceitar tambem esse formato no caso (06). Como fazer?


If Mid(VerData, 7, 4) < 1950 Or Mid(VerData, 7, 4) > 2000 Then

VerData é uma variavel string.
USUARIO.EXCLUIDOS 11/12/2006 10:58:43
#189248 
 

Ano = Mid(VerData, 7)
If Len(Ano) = 2 then Ano = "20" & Ano
USUARIO.EXCLUIDOS 11/12/2006 11:21:24
#189258
Um código melhorado:

 

Dim strAno as String
Dim strVerData as String

'Informar a data pelo TextBox
strVerData = Text1.text

'Pegar apenas o Ano, ou seja, a partir a posição 7, N caracteres
strAno = Trim(Mid(strVerData, 7))

If len(strAno) = 2 then
   'Aceitar resposta entre 2000 e 2010
   If CInt(strAno) >= 0 and CInt(strAno) < 10 then
      strAno = "20" & strAno
   Else
      'Aceitar resposta entre 1911 e 1999
      strAno = "19" & strAno
   End If
End If
IRENKO 11/12/2006 13:05:19
#189277
Andre, a função para testar a data é essa abaixo, gostaria de adaptar somente a parte do ANO, acho que seu cógigo atenderia, mas... Como e onde coloca-lo?

Public Function TestaData(ByVal VerData As String)

Dim xUltimoDiaMes As String
Dim xyAno As Integer
Dim xyMes As Integer

If Trim(VerData) = "" Then
   TestaData = "VAZIO" 'False
   Exit Function
End If

'Testa o Ano
If Mid(VerData, 7, 4) < 1950 Or Mid(VerData, 7, 4) > 2100 Then
   TestaData = "ANO" 'False
   Exit Function
Else
   xyAno = Mid(VerData, 7, 4)
End If
'Testa o Mes
If Mid(VerData, 4, 2) < 1 Or Mid(VerData, 4, 2) > 12 Then
   TestaData = "MES" 'False
   Exit Function
Else
   xyMes = Mid(VerData, 4, 2)
End If

'verifica o ultimo dia do mes da data solicitada
xUltimoDiaMes = Day(DateSerial(xyAno, xyMes + 1, 1) - 1)

'testa o DIA
If Mid(VerData, 1, 2) < 1 Or Mid(VerData, 1, 2) > xUltimoDiaMes Then
   TestaData = "DIA" 'False
   Exit Function
Else
   TestaData = True
End If

End Function



Private Sub TxtPrazo_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Select Case TestaData(TxtPrazo)
        Case Is = "ANO"
            MsgBox "Verifique o ANO !", vbCritical, "Data Inicial Inválida!"
             Cancel = True
   TxtPrazo.SelStart = 0
   TxtPrazo.SelLength = Len(TxtPrazo.text)
            Exit Sub
        Case Is = "MES"
            MsgBox "Verifique o MÃÅ S !", vbCritical, "Data Inicial Inválida!"
             Cancel = True
   TxtPrazo.SelStart = 0
   TxtPrazo.SelLength = Len(TxtPrazo.text)
            Exit Sub
        Case Is = "DIA"
            MsgBox "Verifique o DIA !", vbCritical, "Data Inicial Inválida!"
             Cancel = True
   TxtPrazo.SelStart = 0
   TxtPrazo.SelLength = Len(TxtPrazo.text)
            Exit Sub
    End Select
End Sub
HARRY.POTTER 12/12/2006 02:10:56
#189431
Tenta assim (utilizei o codigo do ANDREMILARE):

Public Function TestaData(ByVal VerData As String) As Boolean

Dim xUltimoDiaMes As String
Dim xyAno As Integer
Dim xyMes As Integer
Dim strAno As String

If Trim(VerData) = "" Then
   TestaData = "VAZIO" 'False
   Exit Function
End If

'Testa o Ano

strAno = VerData
If Len(VerData) = 8 Then
 'Aceitar resposta entre 2000 e 2010
   If CInt(strAno) >= 0 And CInt(strAno) < 10 Then
      strAno = "20" & strAno
   Else
      'Aceitar resposta entre 1911 e 1999
      strAno = "19" & strAno
   End If

ElseIf Len(VerData) = 10 Then
    If Mid(VerData, 7, 4) < 1950 Or Mid(VerData, 7, 4) > 2100 Then
        TestaData = "ANO" 'False
        Exit Function
    Else
        xyAno = Mid(VerData, 7, 4)
    End If
End If

'Testa o Mes
If Mid(VerData, 4, 2) < 1 Or Mid(VerData, 4, 2) > 12 Then
   TestaData = "MES" 'False
   Exit Function
Else
   xyMes = Mid(VerData, 4, 2)
End If

'verifica o ultimo dia do mes da data solicitada
xUltimoDiaMes = Day(DateSerial(xyAno, xyMes + 1, 1) - 1)

'testa o DIA
If Mid(VerData, 1, 2) < 1 Or Mid(VerData, 1, 2) > xUltimoDiaMes Then
   TestaData = "DIA" 'False
   Exit Function
Else
   TestaData = True
End If

End Function
HARRY.POTTER 16/12/2006 00:38:40
#190332
Deu certo?
IRENKO 16/12/2006 09:18:44
#190351
Caro Harry, não deu certo se eu digito o ANO incorretamente não retorna a mensagem de erro do EXIT do TextBox.
USUARIO.EXCLUIDOS 16/12/2006 10:14:58
#190356 Resposta escolhida
Cara, acho que tá mto trampo sua função, não?

Se quer uma dica, use a seguinte função, que acabei de fazer:
Public Function TestaData(ByVal VerData As TextBox) As Boolean
Dim Sep() As String, Msg As String
With VerData
  Sep = Split(VerData.Text, "/")
  
  If UBound(Sep) <> 2 Then
    Msg = "Formato de data inválida!" & vbCrLf & "Favor informar a data no formato ""DD/MM/YYYY""!"
    'GoTo invalida
  Else
    '***Verificando o ano
    '   Verificar se é dois digitos
    If Len(Sep(2)) = 2 Then
      If Sep(2) > 30 Then Sep(2) = "19" & Sep(2) _
      Else Sep(2) = "20" & Sep(2)
    End If
    '   Verificar nr
    If Sep(2) < 1950 Or Sep(2) > 2100 Then
      Msg = "O ano informado é inválido, favor verifcar!"
      'GoTo invalida
    '***Verificar o mês
    ElseIf Sep(1) < 1 Or Sep(1) > 12 Then
      Msg = "O ano informado é inválido, favor verificar!"
      'GoTo invalida
    '***Verifcar o dia
    ElseIf Sep(0) < 1 Or Sep(0) > Day(DateSerial(Sep(2), Sep(1) + 1, 0)) Then
      Msg = "O dia informado é inválido para este mês, favor verificar!"
      'GoTo invalida
    '***Verificação por precaução
    ElseIf IsDate(.Text) = False Then
      Msg = "Data inválida!" & vbCrLf & "Motivo desconhecido!"
    '***Caso chegue aqui a data está correta
    Else
      TestaData = True
      Exit Function
    End If
  End If
  
  '***Caso chegue aqui, a data é inválida
  MsgBox Msg, vbExclamation, "Data inváldia"
  .SetFocus
  .SelStart = 0
  .SelLength = Len(.Text)
  TestaData = False
End With
End Function



Daí em seu textbox:
Private Sub TxtPrazo_LostFocus()
TestaData TxtPrazo
End Sub


Simples não!?

Qualquer dúvida poste...flw
Tópico encerrado , respostas não são mais permitidas
Voltar