Quem converter antes e quizer me enviar o código, fique a vontade!
Ops... o layout disto esta pessimo... qualquer hora arrumo, pelo menos agora esta postado a mensagem!
Código em VB.Net
'Valor Moeda para valor por Extenso
'Laércio - 11/11/2009
'Exemplo chamada = Extenso(CDbl(queryDocCancelados.FieldByName("valortotal").AsCurrency))
Function Extenso (Valor As Double) 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 Double
Dim vliTamanho As Double
'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) = "quatrocentos ":
mlsCentena(5) = "quinhentos ":
mlsCentena(6) = "seiscentos ":
mlsCentena(7) = "setecentos ":
mlsCentena(8) = "oitocentos ":
mlsCentena(9) = "novecentos ":
'Separa valor em grupos
vlsValor = Format(Valor,"0000000000.00") '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 Val(vlsParte) > 0 Then 'ToNumber(vlsParte) > 0 Then
'vliTamanho = Switch(Val(vlsParte) < vlitamanho =" 1" vlitamanho =" 2" vlitamanho =" 3" vlitamanho =" 3"> "00" Then
'alsTexto(vliContador) = alsTexto(vliContador) + mlsCentena(ToNumber(Left(vlsParte, 1))) + "e "
alsTexto(vliContador) = alsTexto(vliContador) + mlsCentena(Val(Left(vlsParte, 1))) + "e "
vliTamanho = 2
Else
'alsTexto(vliTamanho) = alsTexto(vliContador) + IIf(Left(vlsParte, 1) = "1", "cem ", mlsCentena(ToNumber(Left(vlsParte, 1))))
alsTexto(vliTamanho) = alsTexto(vliContador) + IIf(Left(vlsParte, 1) = "1", "cem ", mlsCentena(Val(Left(vlsParte, 1))))
End If
End If
If vliTamanho = 2 Then
If Val(Right(vlsParte, 2)) <> "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)))
alsTexto(vliContador) = alsTexto(vliContador) + mlsUnidade(Val(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
