Caros Amigos,
Estou iniciando no Access 2007,
Estou tentando fazer um relatório onde gera um folha de impressão de cheques, conseguir o valor por extenso na internet, mais preciso de mais, pois além no valor por extenso preciso que esteja entre parêntenses e no final tenha alguns algarismo repetidos, e que cai na segunda linha mais a frente como vem no cheque, como por exemplo:
(QUARENTA REAIS E SETENTA CENTAVOS)X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-
(QUATROCENTOS E CINQUENTA E OITO MIL, TREZENTOS E QUARENTA E QUATRO
REAIS E SETENTA E SETE CENTAVOS)X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X
Aqui esta no que consegui na internet
Function UF_Extenso(nValor As Double) As String
If IsNull(nValor) Or nValor <= 0 Or nValor > 999999999999.99 Then
Exit Function
End If
Dim Contador As Integer
Dim Tamanho As Integer
Dim Valor As String
Dim Parte As String
Dim Final As String
Dim Grupo(5) As String
Dim Texto(5) As String
Dim Unidade(19) As String
Unidade(1) = "UM "
Unidade(2) = "DOIS "
Unidade(3) = "TRES "
Unidade(4) = "QUATRO "
Unidade(5) = "CINCO "
Unidade(6) = "SEIS "
Unidade(7) = "SETE "
Unidade( = "OITO "
Unidade(9) = "NOVE "
Unidade(10) = "DEZ "
Unidade(11) = "ONZE "
Unidade(12) = "DOZE "
Unidade(13) = "TREZE "
Unidade(14) = "QUATORZE "
Unidade(15) = "QUINZE "
Unidade(16) = "DEZESSEIS "
Unidade(17) = "DEZESSETE "
Unidade(18) = "DEZOITO "
Unidade(19) = "DEZENOVE "
Dim Dezena(9) As String
Dezena(1) = "DEZ "
Dezena(2) = "VINTE "
Dezena(3) = "TRINTA "
Dezena(4) = "QUARENTA "
Dezena(5) = "CINQUENTA "
Dezena(6) = "SESSENTA "
Dezena(7) = "SETENTA "
Dezena( = "OITENTA "
Dezena(9) = "NOVENTA "
Dim Centena(9) As String
Centena(1) = "CENTO "
Centena(2) = "DUZENTOS "
Centena(3) = "TREZENTOS "
Centena(4) = "QUATROCENTOS "
Centena(5) = "QUINHENTOS "
Centena(6) = "SEISCENTOS "
Centena(7) = "SETECENTOS "
Centena( = "OITOCENTOS "
Centena(9) = "NOVECENTOS "
Valor = Format(nValor, "000000000000.00")
Grupo(1) = Mid(Valor, 1, 3)
Grupo(2) = Mid(Valor, 4, 3)
Grupo(3) = Mid(Valor, 7, 3)
Grupo(4) = Mid(Valor, 10, 3)
Grupo(5) = "0" + Mid(Valor, 14, 2)
For Contador = 1 To 5
Parte = Grupo(Contador)
Tamanho = Switch(Val(Parte) < 10, 1, Val(Parte) < 100, 2, Val(Parte) < 1000, 3)
If Tamanho = 3 Then
If Right(Parte, 2) <> "00" Then
Texto(Contador) = Texto(Contador) & Centena(Left(Parte, 1)) + "E "
Tamanho = 2
Else
Texto(Contador) = Texto(Contador) & IIf(Left(Parte, 1) = "1", "CEM ", Centena(Left(Parte, 1)))
End If
End If
If Tamanho = 2 Then
If Val(Right(Parte, 2)) < 20 Then
Texto(Contador) = Texto(Contador) & Unidade(Right(Parte, 2))
Else
Texto(Contador) = Texto(Contador) & Dezena(Mid(Parte, 2, 1))
If Right(Parte, 1) <> "0" Then
Texto(Contador) = Texto(Contador) & "E "
Tamanho = 1
End If
End If
End If
If Tamanho = 1 Then
Texto(Contador) = Texto(Contador) & Unidade(Right(Parte, 1))
End If
Next Contador
Final = ""
If Val(Grupo(1) + Grupo(2) + Grupo(3) + Grupo(4)) = 0 And Val(Grupo(5)) > 0 Then
Final = Texto(5) & IIf(Val(Grupo(5)) = 1, "CENTAVO", "CENTAVOS")
Else
Final = Final & IIf(Val(Grupo(1)) > 0, Texto(1) & IIf(Val(Grupo(1)) > 1, "BILHÕES ", "BILHÃO "), "")
Final = Final & IIf(Val(Grupo(2)) > 0, Texto(2) & IIf(Val(Grupo(2)) > 1, "MILHÕES ", "MILHÃO "), "")
If Val(Grupo(2) + Grupo(3) + Grupo(4)) = 0 Then
Final = Final & "DE "
Else
Final = Final & IIf(Val(Grupo(3)) > 0, Texto(3) & "MIL ", "")
End If
Final = Final & Texto(4) + IIf(Val(Grupo(1) + Grupo(2) + Grupo(3) + Grupo(4)) = 1, "REAL ", "REAIS ")
Final = Final & IIf(Val(Grupo(5)) > 0, "E " & Texto(5) & IIf(Val(Grupo(5)) = 1, "CENTAVO", "CENTAVOS"), "")
End If
UF_Extenso = Final
End Function
Grato pela ajuda antecipada.
Editado pelo Moderador Dilson - Data/hora: Ter Fev 22, 2011 2:36 pm - Motivação: Uso indevido de letras maiúsculas.
Estou iniciando no Access 2007,
Estou tentando fazer um relatório onde gera um folha de impressão de cheques, conseguir o valor por extenso na internet, mais preciso de mais, pois além no valor por extenso preciso que esteja entre parêntenses e no final tenha alguns algarismo repetidos, e que cai na segunda linha mais a frente como vem no cheque, como por exemplo:
(QUARENTA REAIS E SETENTA CENTAVOS)X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-
(QUATROCENTOS E CINQUENTA E OITO MIL, TREZENTOS E QUARENTA E QUATRO
REAIS E SETENTA E SETE CENTAVOS)X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X-X
Aqui esta no que consegui na internet
Function UF_Extenso(nValor As Double) As String
If IsNull(nValor) Or nValor <= 0 Or nValor > 999999999999.99 Then
Exit Function
End If
Dim Contador As Integer
Dim Tamanho As Integer
Dim Valor As String
Dim Parte As String
Dim Final As String
Dim Grupo(5) As String
Dim Texto(5) As String
Dim Unidade(19) As String
Unidade(1) = "UM "
Unidade(2) = "DOIS "
Unidade(3) = "TRES "
Unidade(4) = "QUATRO "
Unidade(5) = "CINCO "
Unidade(6) = "SEIS "
Unidade(7) = "SETE "
Unidade( = "OITO "
Unidade(9) = "NOVE "
Unidade(10) = "DEZ "
Unidade(11) = "ONZE "
Unidade(12) = "DOZE "
Unidade(13) = "TREZE "
Unidade(14) = "QUATORZE "
Unidade(15) = "QUINZE "
Unidade(16) = "DEZESSEIS "
Unidade(17) = "DEZESSETE "
Unidade(18) = "DEZOITO "
Unidade(19) = "DEZENOVE "
Dim Dezena(9) As String
Dezena(1) = "DEZ "
Dezena(2) = "VINTE "
Dezena(3) = "TRINTA "
Dezena(4) = "QUARENTA "
Dezena(5) = "CINQUENTA "
Dezena(6) = "SESSENTA "
Dezena(7) = "SETENTA "
Dezena( = "OITENTA "
Dezena(9) = "NOVENTA "
Dim Centena(9) As String
Centena(1) = "CENTO "
Centena(2) = "DUZENTOS "
Centena(3) = "TREZENTOS "
Centena(4) = "QUATROCENTOS "
Centena(5) = "QUINHENTOS "
Centena(6) = "SEISCENTOS "
Centena(7) = "SETECENTOS "
Centena( = "OITOCENTOS "
Centena(9) = "NOVECENTOS "
Valor = Format(nValor, "000000000000.00")
Grupo(1) = Mid(Valor, 1, 3)
Grupo(2) = Mid(Valor, 4, 3)
Grupo(3) = Mid(Valor, 7, 3)
Grupo(4) = Mid(Valor, 10, 3)
Grupo(5) = "0" + Mid(Valor, 14, 2)
For Contador = 1 To 5
Parte = Grupo(Contador)
Tamanho = Switch(Val(Parte) < 10, 1, Val(Parte) < 100, 2, Val(Parte) < 1000, 3)
If Tamanho = 3 Then
If Right(Parte, 2) <> "00" Then
Texto(Contador) = Texto(Contador) & Centena(Left(Parte, 1)) + "E "
Tamanho = 2
Else
Texto(Contador) = Texto(Contador) & IIf(Left(Parte, 1) = "1", "CEM ", Centena(Left(Parte, 1)))
End If
End If
If Tamanho = 2 Then
If Val(Right(Parte, 2)) < 20 Then
Texto(Contador) = Texto(Contador) & Unidade(Right(Parte, 2))
Else
Texto(Contador) = Texto(Contador) & Dezena(Mid(Parte, 2, 1))
If Right(Parte, 1) <> "0" Then
Texto(Contador) = Texto(Contador) & "E "
Tamanho = 1
End If
End If
End If
If Tamanho = 1 Then
Texto(Contador) = Texto(Contador) & Unidade(Right(Parte, 1))
End If
Next Contador
Final = ""
If Val(Grupo(1) + Grupo(2) + Grupo(3) + Grupo(4)) = 0 And Val(Grupo(5)) > 0 Then
Final = Texto(5) & IIf(Val(Grupo(5)) = 1, "CENTAVO", "CENTAVOS")
Else
Final = Final & IIf(Val(Grupo(1)) > 0, Texto(1) & IIf(Val(Grupo(1)) > 1, "BILHÕES ", "BILHÃO "), "")
Final = Final & IIf(Val(Grupo(2)) > 0, Texto(2) & IIf(Val(Grupo(2)) > 1, "MILHÕES ", "MILHÃO "), "")
If Val(Grupo(2) + Grupo(3) + Grupo(4)) = 0 Then
Final = Final & "DE "
Else
Final = Final & IIf(Val(Grupo(3)) > 0, Texto(3) & "MIL ", "")
End If
Final = Final & Texto(4) + IIf(Val(Grupo(1) + Grupo(2) + Grupo(3) + Grupo(4)) = 1, "REAL ", "REAIS ")
Final = Final & IIf(Val(Grupo(5)) > 0, "E " & Texto(5) & IIf(Val(Grupo(5)) = 1, "CENTAVO", "CENTAVOS"), "")
End If
UF_Extenso = Final
End Function
Grato pela ajuda antecipada.
Editado pelo Moderador Dilson - Data/hora: Ter Fev 22, 2011 2:36 pm - Motivação: Uso indevido de letras maiúsculas.