Does date for extensive where error?

[Frank Dulk]

Although it has gotten to rotate the code of the date with DLL, would have
problem with my DEAR users.. for that, catching a little bit of here and of
there, I set up that code of dates for extensive, with 2 functions just...


Function Extenso(nValor)

'Variáveis
Dim nContador, nTamanho As Integer
Dim cValor, cParte, cFinal, ano, resto As String
ReDim agrupo(2), atexto(2) As String

'Matrizes de extensos (Parciais)
ReDim aUnid(19) As String
aUnid(1) = "um ": aUnid(2) = "dois ": aUnid(3) = "tres "
aUnid(4) = "quatro ": aUnid(5) = "cinco ": aUnid(6) = "seis "
aUnid(7) = "sete ": aUnid(8) = "oito ": aUnid(9) = "nove "
aUnid(10) = "dez ": aUnid(11) = "onze ": aUnid(12) = "doze "
aUnid(13) = "treze ": aUnid(14) = "quatorze ": aUnid(15) = "quinze "
aUnid(16) = "dezesseis ": aUnid(17) = "dezessete ": aUnid(18) = "dezoito "
aUnid(19) = "dezenove "

ReDim aDezena(9) As String
aDezena(1) = "dez ": aDezena(2) = "vinte ": aDezena(3) = "trinta "
aDezena(4) = "quarenta ": aDezena(5) = "cinquenta "
aDezena(6) = "sessenta ": aDezena(7) = "setenta ": aDezena(8) = "oitenta "
aDezena(9) = "noventa "

ReDim aCentena(9) As String
aCentena(1) = "cento ": aCentena(2) = "duzentos "
aCentena(3) = "trezentos ": aCentena(4) = "quatrocentos "
aCentena(5) = "quinhentos ": aCentena(6) = "seiscentos "
aCentena(7) = "setecentos ": aCentena(8) = "oitocentos "
aCentena(9) = "novecentos "

'Separa valor em grupos

agrupo(1) = Mid$(nValor, 2, 3)
agrupo(2) = Left$(nValor, 1)

atexto(1) = ""
If agrupo(2) = 1 Then
atexto(2) = "mil "
ElseIf agrupo(2) = 2 Then
atexto(2) = "dois mil "
End If

If agrupo(1) <> "000" Then

cParte = agrupo(1)
nTamanho = Switch(Val(cParte) < 10, 1, Val[cParte) < 100, 2, Val[cParte) <
1000, 3)
If nTamanho = 3 Then
If Right$(cParte, 2) <> "00" Then
atexto(1) = atexto(1) + aCentena(Left(cParte, 1))
nTamanho = 2
Else
atexto(1) = atexto(1) + IIf(Left$(cParte, 1) = "1", "cem ",
aCentena(Left(cParte, 1)))
End If
End If
If nTamanho = 2 Then
If Val(Right(cParte, 2)) < 20 Then
atexto(1) = atexto(1) + "e " + aUnid(Right(cParte, 2))
Else
atexto(1) = atexto(1) + "e " + aDezena(Mid(cParte, 2, 1))
If Right$(cParte, 1) <> "0" Then
atexto(1) = "e " + atexto(1)
nTamanho = 1
End If
End If
End If
If nTamanho = 1 Then
atexto(1) = atexto(1) + "e " + aUnid(Right(cParte, 1))
End If
End If
cFinal = atexto(2) & atexto(1)
Extenso = cFinal
'Final

End Function

Public Function ExtensoData(UmaData As Variant)

On Error GoTo Erros

If Month(UmaData) > 12 Then
Error 9
End If

Dim IniData As String
IniData = CDate(UmaData)
If Not IsDate(UmaData) Then
MsgBox "Data inválida"
Exit Function
End If

TodosDias = Array("", "um ", "dois ", "três ", "quatro ", _
"cinco ", "seis ", "sete ", "oito ", "nove ", "dez ", _
"onze ", "doze ", "treze ", "quatorze ", "quinze ", _
"dezesseis ", "dezessete ", "dezoito ", "dezenove ", "vinte ", _
"vinte e um ", "vinte e dois ", "vinte e três ", "vinte e quatro ", _
"vinte e cinco ", "vinte e seis ", "vinte e sete ", "vinte e oito ", _
"vinte e nove ", "trinta ", "trinta e um ")

TodosMeses = Array("", "janeiro ", "fevereiro ", "março ", _
"abril ", "maio ", "junho ", "julho ", "agosto ", "setembro ", _
"outubro ", "novembro ", "dezembro ")

Dim DiaData, MesData, AnoData As String

DiaData = TodosDias(Day(IniData))

MesData = TodosMeses(Month(IniData))

AnoData = Extenso(Year(IniData))'funcao para traduzir o ano

ExtensoData = DiaData & "de " & MesData & "de " & AnoData
Erros:
If Err.Number = 9 Or Err.Number = 13 Then
MsgBox "Data inválida"
Exit Function
End If

End Function