Boa noite Assis...
Observando pausadamente o código percebi que a execução do mesmo é interrompida na seguinte linha:
Select Case Val(Mid(iniData, 9, 1))
Case 1
ADezena = SoOsDez(Val(Right(iniData, 2))) Case 2
ADezena = "Vinte"
Bem.. esta linha é executada quando o ano está contido de 10 a 19
A linha que suponho que seja complementar a esta é:
De10a19 = Array("Dez", "Onze", "Doze", "Treze", "Quatorze", "Quinze", "Dezesseis", "Dezessete", "Dezoito", "Dezenove")Então... Excluí a linha acima em azul...
Dimensionei a variável de10a19 em uma matriz com nove campos iniciando pelo 10 até o 19:
Dim De10a19(10 To 19)Coloquei no lugar da linha em azul a matriz carregada com os devidos meses:
De10a19(10) = "Dez"
De10a19(11) = "Onze"
De10a19(12) = "Doze"
De10a19(13) = "Treze"
De10a19(14) = "Quartoze"
De10a19(15) = "Quinze"
De10a19(16) = "Dezesseis"
De10a19(17) = "Dezesset"
De10a19(18) = "Dezoito"
De10a19(19) = "Dezenove"e na linha onde ocorre o erro:
ADezena = De10a19(Val(Right(iniData, 2)))Eis o código completo:
Public Function ExtensoData(UmaData As Variant)
On Error GoTo Erros
Dim TodoDias
Dim Todosdias, TodosMeses As Variant
Dim A2000, A2001, A1900 As String
Dim De10a19(10 To 19)
If Val(Mid(UmaData, 4, 2)) > 12 Then
Error 9
End If
Dim SoOsDez, ADezena As Variant
Dim iniData As String
iniData = Format(CDate(UmaData), "dd/mm/yyyy")
If Not IsDate(UmaData) Then
'MsgBox "Data Superior ao Dia de Hoje"
Exit Function
End If
Todosdias = Array("", "Um ", "Dois ", "Três ", "Quatro ", "Cinco ", "Seis ", "Sete ", "Oito ", "Nove ", "Dez ", _
"Onze ", "Doze ", "Treze ", "Quatorze ", "Quinze ", "Dezasseis ", "Dezassete ", "Dezoito ", "Dezanove ", "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 ")
'De10a19 = Array("Dez", "Onze", "Doze", "Treze", "Quatorze", "Quinze", "Dezesseis", "Dezessete", "Dezoito", "Dezenove")
De10a19(10) = "Dez"
De10a19(11) = "Onze"
De10a19(12) = "Doze"
De10a19(13) = "Treze"
De10a19(14) = "Quartoze"
De10a19(15) = "Quinze"
De10a19(16) = "Dezesseis"
De10a19(17) = "Dezesset"
De10a19(18) = "Dezoito"
De10a19(19) = "Dezenove"
TodosMeses = Array("", "Janeiro ", "Fevereiro ", "Março ", "Abril ", "Maio ", "Junho ", "Julho ", _
"Agosto ", "Setembro ", "Outubro ", "Novembro ", "Dezembro ")
A2000 = "Dois Mil"
A2001 = "Dois Mil e "
A1900 = "Mil Novecentos e "
Dim DiaData, MesData, AnoData As String
'
If Left(iniData, 2) = "01" Then ' ***
DiaData = "Um " ' ***
Else ' ***
DiaData = Todosdias(Val(Left(iniData, 2)))
End If ' ***
MesData = TodosMeses(Val(Mid(iniData, 4, 2)))
Select Case Val(Right(iniData, 4))
Case Is < 2000
AnoData = A1900
Case 2000 To 2009
AnoData = A2000
Case Else
AnoData = A2001
End Select
Select Case Val(Mid(iniData, 9, 1))
Case 1
ADezena = De10a19(Val(Right(iniData, 2)))
Case 2
ADezena = "Vinte"
Case 3
ADezena = "Trinta"
Case 4
ADezena = "Quarenta"
Case 5
ADezena = "Cinquenta"
Case 6
ADezena = "Sessenta"
Case 7
ADezena = "Setenta"
Case 8
ADezena = "Oitenta"
Case 9
ADezena = "Noventa"
Case 0
ADezena = ""
End Select
If Val(Right(iniData, 1)) = 0 Then
ExtensoData = DiaData & " de " & MesData & "de " & AnoData & ADezena
Else
ExtensoData = DiaData & "de " & MesData & "de " & AnoData & ADezena _
& " e " & Todosdias(Val(Right(iniData, 1)))
End If
If Val(Right(iniData, 2)) > 10 And Val(Right(iniData, 2)) < 20 Then
ExtensoData = DiaData & "de " & MesData & "de " & AnoData & ADezena
End If
ExtensoData = "" & Trim(ExtensoData) & ""
Erros:
If err.Number = 9 Or err.Number = 13 Then
'MsgBox "Data Superior ao Dia de Hoje"
Exit Function
End If
End Function
Cumprimentos.