|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Crystal Reports)
|
|
 |
Título da Dica: Crystal 11 - Conversão de valor para Moeda por Extenso
|
 |
|
|
|
Postada em 1/3/2007 por Marcos
Atenção: Segue uma dica para quem quer converter um valor para extenso
Vá na area WorkShop formula do crystal e dê um Novo para função Personalizada.
Na sintaxe, altere de Sintaxe do Crystal para Sixtase do Basic.
Em seguida no editor de formula adicione o código a seguir
Function Extenso (Valor as Number) as String
if Valor <= 0 or Valor > 999999999.99 then
Exit Function
end if
'Variáveis
Dim vlsValor as String
Dim vlsParte as String
Dim vlsFinal as String
Dim vliContador as Number
Dim vliTamanho as Number
'Arrays
Dim alsGrupo() as String
Redim alsGrupo(4)
Dim alsTexto() as String
Redim alsTexto(4)
'Matrizes de extensos (Parciais)
Dim mlsUnidade() as String
Redim mlsUnidade(19)
mlsUnidade(1) = "um ":
mlsUnidade(2) = "dois ":
mlsUnidade(3) = "três ":
mlsUnidade(4) = "quatro ":
mlsUnidade(5) = "cinco ":
mlsUnidade(6) = "seis ":
mlsUnidade(7) = "sete ":
mlsUnidade(8) = "oito ":
mlsUnidade(9) = "nove ":
mlsUnidade(10) = "dez ":
mlsUnidade(11) = "onze ":
mlsUnidade(12) = "doze ":
mlsUnidade(13) = "treze ":
mlsUnidade(14) = "quatorce ":
mlsUnidade(15) = "quinze ":
mlsUnidade(16) = "dezesseis ":
mlsUnidade(17) = "dezessete ":
mlsUnidade(18) = "dezoito ":
mlsUnidade(19) = "dezenove ":
Dim mlsDezena() as String
Redim mlsDezena(9)
mlsDezena(1) = "dez ":
mlsDezena(2) = "vinte ":
mlsDezena(3) = "trinta ":
mlsDezena(4) = "quarenta ":
mlsDezena(5) = "cinqüenta ":
mlsDezena(6) = "sessenta ":
mlsDezena(7) = "setenta ":
mlsDezena(8) = "oitenta ":
mlsDezena(9) = "noventa ":
Dim mlsCentena() as String
Redim mlsCentena(9)
mlsCentena(1) = "cento ":
mlsCentena(2) = "duzentos ":
mlsCentena(3) = "trezentos ":
mlsCentena(4) = "quatrozentos ":
mlsCentena(5) = "quinhentos ":
mlsCentena(6) = "seiscentos ":
mlsCentena(7) = "setecentos ":
mlsCentena(8) = "oitocentos ":
mlsCentena(9) = "novecentos ":
'Separa valor em grupos
vlsValor = ToText(Valor, "0000000000.00")
alsGrupo(1) = Mid(vlsValor, 2, 3)
alsGrupo(2) = Mid(vlsValor, 5, 3)
alsGrupo(3) = Mid(vlsValor, 8, 3)
alsGrupo(4) = "0" + Mid(vlsValor, 12,2)
'Calcula cada Grupo
For vliContador = 1 to 4
vlsParte = alsGrupo(vliContador)
If ToNumber(vlsParte) > 0 then
vliTamanho = Switch(val(vlsParte) < 10, 1, Val(vlsParte) < 100, 2, Val(vlsParte) < 1000, 3)
if vliTamanho = 3 then
If Right(vlsParte, 2) <> "00" Then
alsTexto(vliContador) = alsTexto(vliContador) + mlsCentena(ToNumber(Left(vlsParte, 1))) + "e "
vliTamanho = 2
Else
alsTexto(vliTamanho) = alsTexto(vliContador) + Iif(Left(vlsParte, 1) = "1", "cem ", mlsCentena(ToNumber(Left(vlsParte, 1))))
End If
End if
If vliTamanho = 2 Then
If Val(Right(vlsParte, 2)) < 20 then
alsTexto(vliContador) = alsTexto(vliContador) + mlsUnidade(ToNumber(Right(vlsParte, 2)))
Else
alsTexto(vliContador) = alsTexto(vliContador) + mlsDezena(ToNumber(Mid(vlsParte, 2,1)))
If Right(vlsParte, 1) <> "0" then
alsTexto(vliContador) = alsTexto(vliContador) + "e "
vliTamanho = 1
End IF
End If
End If
If vliTamanho = 1 Then
alsTexto(vliContador) = alsTexto(vliContador) + mlsUnidade(ToNumber(Right(vlsParte, 1)))
End IF
End If
Next
'Final
If Val(alsGrupo(1)+ alsGrupo(2) + alsGrupo(3) ) = 0 And Val(alsGrupo(4)) <> 0 Then
vlsFinal = alsTexto(4) + IIF (Val(alsGrupo(4)) = 1, "centavo", "centavos")
Else
vlsFinal = ""
vlsFinal = vlsfinal + IIF(Val(alsGrupo(1)) <> 0, alsTexto(1) + IIF(Val(alsGrupo(1)) > 1, "milhões ", "milhão "), "")
If Val(alsGrupo(2) + alsGrupo(3)) = 0 Then
vlsFinal = vlsFinal + "de "
Else
vlsFinal = vlsFinal + IIF(Val(alsGrupo(2)) <> 0 , alsTexto(2) + "mil ", "")
End IF
vlsFinal = vlsFinal + alsTexto(3) + IIF(Val(alsGrupo(1) + alsGrupo(2) + alsGrupo(3)) = 1, "real ", "reais ")
vlsFinal = vlsFinal + IIF(Val(alsGrupo(4)) <> 0, "e " + alsTexto(4) + IIF(Val(alsGrupo(4)) = 1, "centavo", "centavos"), "")
End if
Extenso = Ucase(Mid(vlsFinal, 1,1)) + LCase(Mid(vlsFinal, 2))
End Function
Para verificar o resultado, crie um relatório em branco,
e utilize
Extenso({CampoaSerConvertido})
|
|
|
|
|
