VALORES POR EXTENSO

JEAN.JEDSON 17/07/2005 09:38:19
#94550

bem...
digamos que, de forma até certo ponto "burra", vc poderia colocar no fim da função verificando se LEFT(VariávelExtenso) = "um mil", e substituir por mil.

MAGICMEN 17/07/2005 17:49:38
#94583

Ainda não foi desta que consegui lá chegar
tenho esta rotina e já tentei como me disseste mas o resultado não dá



Option Explicit

Private Sub Command1_Click()
'P/ chamar a função:



Dim sRet As String
Dim dValor As String


If Left(txt2.Text, 6) = "um mil" Then

txt3.Text = "mil"
Else
txt3.Text = "Falhou"
End If

dValor = txt2.Text
sRet = Extenso(dValor, "euros", "euro")
txt1.Text = sRet
End Sub

USUARIO.EXCLUIDOS 17/07/2005 18:09:47
#94588 Resposta escolhida

Que confusão dos infernos! Em qual texbox esta o valor por extenso ???
Você esta testando o conteúdo de txt2 sem que ao menos apareça onde foi atribuido seu valor.
o valor por extenso a ser corrigido não estaria em sRet???

MAGICMEN 17/07/2005 19:15:41
#94600

no modulo tenho

Option Explicit

'Num módulo:
Public Function Extenso(ByVal Valor As _
Double, ByVal MoedaPlural As _
String, ByVal MoedaSingular As _
String) As String
Dim StrValor As String, Negativo As Boolean
Dim Buf As String, Parcial As Integer
Dim Posicao As Integer, Unidades
Dim Dezenas, Centenas, PotenciasSingular
Dim PotenciasPlural

Negativo = (Valor < 0)
Valor = Abs(CDec(Valor))
If Valor Then
Unidades = Array(vbNullString, "Um", "Dois", _
"Três", "Quatro", "Cinco", _
"Seis", "Sete", "Oito", "Nove", _
"Dez", "Onze", "Doze", "Treze", _
"Quatorze", "Quinze", "Dezesseis", _
"Dezessete", "Dezoito", "Dezenove")
Dezenas = Array(vbNullString, vbNullString, _
"Vinte", "Trinta", "Quarenta", _
"Cinqà¼enta", "Sessenta", "Setenta", _
"Oitenta", "Noventa")
Centenas = Array(vbNullString, "Cento", _
"Duzentos", "Trezentos", _
"Quatrocentos", "Quinhentos", _
"Seiscentos", "Setecentos", _
"Oitocentos", "Novecentos")
PotenciasSingular = Array(vbNullString, " Mil", _
" Milhão", " Bilhão", _
" Trilhão", " Quatrilhão")
PotenciasPlural = Array(vbNullString, " Mil", _
" Milhões", " Bilhões", _
" Trilhões", " Quatrilhões")

StrValor = Left(Format(Valor, String(18, "0") & _
".000"), 18)
For Posicao = 1 To 18 Step 3
Parcial = Val(Mid(StrValor, Posicao, 3))
If Parcial Then
If Parcial = 1 Then
Buf = "Um" & PotenciasSingular((18 - _
Posicao) \ 3)
ElseIf Parcial = 100 Then
Buf = "Cem" & PotenciasSingular((18 - _
Posicao) \ 3)
Else
Buf = Centenas(Parcial \ 100)
Parcial = Parcial Mod 100
If Parcial <> 0 And Buf <> vbNullString Then
Buf = Buf & " e "
End If
If Parcial < 20 Then
Buf = Buf & Unidades(Parcial)
Else
Buf = Buf & Dezenas(Parcial \ 10)
Parcial = Parcial Mod 10
If Parcial <> 0 And Buf <> vbNullString Then
Buf = Buf & " e "
End If
Buf = Buf & Unidades(Parcial)
End If
Buf = Buf & PotenciasPlural((18 - Posicao) \ 3)
End If
If Buf <> vbNullString Then
If Extenso <> vbNullString Then
Parcial = Val(Mid(StrValor, Posicao, 3))
If Posicao = 16 And (Parcial < 100 Or _
(Parcial Mod 100) = 0) Then
Extenso = Extenso & " e "
Else
Extenso = Extenso & ", "
End If
End If
Extenso = Extenso & Buf
End If
End If
Next
If Extenso <> vbNullString Then
If Negativo Then
Extenso = "Menos " & Extenso
End If
If Int(Valor) = 1 Then
Extenso = Extenso & " " & MoedaSingular
Else
Extenso = Extenso & " " & MoedaPlural
End If
End If
Parcial = Int((Valor - Int(Valor)) * _
100 + 0.1)
If Parcial Then
Buf = Extenso(Parcial, "Centavos", _
"Centavo")
If Extenso <> vbNullString Then
Extenso = Extenso & " e "
End If
Extenso = Extenso & Buf
End If
End If
End Function



e no form


Option Explicit

Private Sub Command1_Click()
'P/ chamar a função:



Dim sRet As String
Dim dValor As String


If Left(txt2.Text, 6) = "um mil" Then

txt3.Text = "mil"
Else
txt3.Text = "Falhou"
End If

dValor = txt2.Text
sRet = Extenso(dValor, "euros", "euro")
txt1.Text = sRet
End Sub


onde no txt1 coloco os valores numéricos

no txt2 saem por extenso

no txt3 era para testar

Obrg.

USUARIO.EXCLUIDOS 17/07/2005 22:05:30
#94616

Citação:

onde no txt1 coloco os valores numéricos

no txt2 saem por extenso

no txt3 era para testar

Private Sub Command1_Click()
Dim sRet As String

sRet = Extenso(Val(txt1.Text), "euros", "euro")
If Left(sRet, 7) = "Um Mil " Then
txt2.Text = Mid(sRet, 8)
Else
txt2.Text = sRet
End If
End Sub

FELIPEA 17/07/2005 22:54:55
#94620

acho que isso esclarece tudo =D
Alias no site tem um(s) exemplo(s) de valor por extenso!

ENCERRE O TÓ“PICO