jcmweb
|
ARARAQUARA
SP - BRASIL
|
|
ENUNCIADA !
|
|
|
|
|
|
rdeletric
|
SÃO JOSÉ DO RIO PRETO
SP - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 26/10/2005 12:07 hs
'FUNÇÃO: Public Function numeroExtenso(vNumero As Variant, Optional bMoeda As Boolean = True) As String Dim iContador As Integer
Dim iTamanho As Integer
Dim sValor As String
Dim sParte As String
Dim sFinal As String
If IsNull(vNumero) Or vNumero <= 0 Or vNumero > 9999999.99 Or Not IsNumeric(vNumero) Then Exit Function
ReDim matGrupo(4), matTexto(4) As String ReDim matUnidades(19) As String
matUnidades(1) = "Um "
matUnidades(2) = "Dois "
matUnidades(3) = "Tres "
matUnidades(4) = "Quatro "
matUnidades(5) = "Cinco "
matUnidades(6) = "Seis "
matUnidades(7) = "Sete "
matUnidades(8) = "Oito "
matUnidades(9) = "Nove "
matUnidades(10) = "Dez "
matUnidades(11) = "Onze "
matUnidades(12) = "Doze "
matUnidades(13) = "Treze "
matUnidades(14) = "Quatorze "
matUnidades(15) = "Quinze "
matUnidades(16) = "Dezesseis "
matUnidades(17) = "Dezessete "
matUnidades(18) = "Dezoito "
matUnidades(19) = "Dezenove "
ReDim matDezenas(9) As String
matDezenas(1) = "Dez "
matDezenas(2) = "Vinte "
matDezenas(3) = "Trinta "
matDezenas(4) = "Quarenta "
matDezenas(5) = "Cinquenta "
matDezenas(6) = "Sessenta "
matDezenas(7) = "Setenta "
matDezenas(8) = "Oitenta "
matDezenas(9) = "Noventa "
ReDim matCentenas(9) As String
matCentenas(1) = "Cento "
matCentenas(2) = "Duzentos "
matCentenas(3) = "Trezentos "
matCentenas(4) = "Quatrocentos "
matCentenas(5) = "Quinhentos "
matCentenas(6) = "Seiscentos "
matCentenas(7) = "Setecentos "
matCentenas(8) = "Oitocentos "
matCentenas(9) = "Novecentos "
sValor = Format(vNumero, "0000000000.00")
matGrupo(1) = Mid(sValor, 2, 3)
matGrupo(2) = Mid(sValor, 5, 3)
matGrupo(3) = Mid(sValor, 8, 3)
matGrupo(4) = "0" + Mid(sValor, 12, 2)
For iContador = 1 To 4 sParte = matGrupo(iContador) iTamanho = Switch(Val(sParte) < 10, 1, Val(sParte) < 100, 2, Val(sParte) < 1000, 3) If iTamanho = 3 Then
If Right(sParte, 2) <> "00" Then
matTexto(iContador) = matTexto(iContador) + matCentenas(Left(sParte, 1)) + "e "
iTamanho = 2
Else
matTexto(iContador) = matTexto(iContador) + IIf(Left(sParte, 1) = "1", "Cem ", _
matCentenas(Left(sParte, 1)))
End If
End If If iTamanho = 2 Then
If Val(Right(sParte, 2)) < 20 Then
matTexto(iContador) = matTexto(iContador) + matUnidades(Right(sParte, 2))
Else
matTexto(iContador) = matTexto(iContador) + matDezenas(Mid(sParte, 2, 1))
If Right(sParte, 1) <> "0" Then
matTexto(iContador) = matTexto(iContador) + "e "
iTamanho = 1
End If
End If
End If If iTamanho = 1 Then
matTexto(iContador) = matTexto(iContador) + matUnidades(Right(sParte, 1))
End If Next If Val(matGrupo(1) + matGrupo(2) + matGrupo(3)) = 0 And Val(matGrupo(4)) <> 0 Then
sFinal = matTexto(4) + IIf(Val(matGrupo(4)) = 1, "centavo", "centavos")
Else
sFinal = ""
sFinal = sFinal + IIf(Val(matGrupo(1)) <> 0, matTexto(1) + IIf(Val(matGrupo(1)) > 1, _
"milhões ", "milhão "), "")
If Val(matGrupo(2) + matGrupo(3)) = 0 Then
sFinal = sFinal + "de "
Else
sFinal = sFinal + IIf(Val(matGrupo(2)) <> 0, matTexto(2) + "Mil ", "")
End If
If Not bMoeda Then
sFinal = sFinal + matTexto(3) + IIf(Val(matGrupo(4)) <> 0, "Virgula " + matTexto(4), "")
Else
sFinal = sFinal + matTexto(3) + IIf(Val(matGrupo(1) + matGrupo(2) + matGrupo(3)) = 1, " ", _
" ")
sFinal = sFinal + IIf(Val(matGrupo(4)) <> 0, "e " + matTexto(4) + IIf(Val(matGrupo(4)) = 1, _
"centavo", "centavos"), "")
End If End If numeroExtenso = sFinal End Function '**Chamada da Função
Label1.Caption = numeroExtenso(Text1.Text) |
|
|
|
Martini
|
PAROBÉ
RS - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 26/10/2005 12:17 hs
com a DLL Extens32.dll Public Declare Function extenso Lib "Extens32.dll"(ByVal Valor As String, ByVal Retorno As String) As Integer Public Function PassaExtenso(ValorII As Double) As String
' Passa um número para a DLL e
' recebe-o de volta por extenso
On Error GoTo Passa_Err
Dim Retorno$, x%
Retorno$ = Space$(512)
x% = extenso(ValorII, Retorno$)
PassaExtenso = UCase(Trim$(Retorno$))
Passa_Fim:
Exit Function
Passa_Err:
MsgBox Error$(Err)
Resume Passa_Fim
End Function
usar ... ucase(PassaExtenso(Valor_pago)) |
|
|
|
Korn
|
SAO PAULO
SP - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 26/10/2005 14:54 hs
veja se serve esse aki irmao Public Function Extenso_Monetario(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_Monetario <> vbNullString Then
Parcial = Val(Mid(strValor, Posicao, 3))
If Posicao = 16 And (Parcial < 100 Or _
(Parcial Mod 100) = 0) Then
Extenso_Monetario = Extenso_Monetario & " e "
Else
Extenso_Monetario = Extenso_Monetario & ", "
End If
End If
Extenso_Monetario = Extenso_Monetario & Buf
End If
End If
Next
If Extenso_Monetario <> vbNullString Then
If Negativo Then
Extenso_Monetario = "Menos " & Extenso_Monetario
End If
If Int(VALOR) = 1 Then
Extenso_Monetario = Extenso_Monetario & " " & MoedaSingular
Else
Extenso_Monetario = Extenso_Monetario & " " & MoedaPlural
End If
End If
Parcial = Int((VALOR - Int(VALOR)) * _
100 + 0.1)
If Parcial Then
Buf = Extenso_Monetario(Parcial, "Centavos", _
"Centavo")
If Extenso_Monetario <> vbNullString Then
Extenso_Monetario = Extenso_Monetario & " e "
End If
Extenso_Monetario = Extenso_Monetario & Buf
End If
End If End Function depois ponha isso no lost do txt txtvalorentenso = Extenso_Monetario(txtvalor, "Reais", "Real")
Jesus Cristo é O Senhor!!!
|
|
|
|
Gboese
|
SANTO ANDRÉ
SP - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 27/10/2005 13:43 hs
Se vc não quiser escrever o código para transformar, pegue uma ocx aqui no VBWeb chamada TomCaixa... Com ela você consegue isso.. Abraços |
|
|
|
|
