by Gabriel Tavares de Oliveira Castellani (5 Submissions)
Category: Miscellaneous
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Thu 26th August 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
EXTENSO (Port.) - Converte n¨meros em valor por extenso (converts numbers into string with currency.: i.e.: 123.45 -> "cento e vinte e tr¨s
API Declarations
Global gstrSeparadorDecimal As String
Global gstrSeparadorMilhar As String
Global gstrSeparadorData As String
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
VBcoders
'Sub CaregaConfiguraçõesRegionais()
'Gabriel Tavares de Oliveira Castellani
'Carrega os padrões de ponto decimal, separador de milhar e
'data do Windows
Sub CarregaConfiguracoesRegionais()
Dim ret As Long
Dim auxSep As String * 2
'le separador decimal do win.ini
ret = GetProfileString("intl", "sDecimal", ".", auxSep, 2)
gstrSeparadorDecimal = Left$(auxSep, 1)
'le separador de milhar do win.ini
ret = GetProfileString("intl", "sThousand", ",", auxSep, 2)
gstrSeparadorMilhar = Left$(auxSep, 1)
'le separador de data do win.ini
ret = GetProfileString("intl", "sDate", "/", auxSep, 2)
gstrSeparadorData = Left$(auxSep, 1)
End Sub
'*************************************************************
' Função CDUEXTENSO - CALLED BY EXTENSO (BELLOW)
'*************************************************************
' Gabriel Tavares de Oliveira Castellani
'*************************************************************
' Retorna um valor por extenso
'*************************************************************
Function CDUExtenso(ByVal Valor As Integer) As String
Dim eastrU(0 To 19) As String
Dim eastrD(2 To 9) As String
Dim eastrC(0 To 9) As String
Dim estrValor As String
eastrU(0) = ""
eastrU(1) = " e um"
eastrU(2) = " e dois"
eastrU(3) = " e três"
eastrU(4) = " e quatro"
eastrU(5) = " e cinco"
eastrU(6) = " e seis"
eastrU(7) = " e sete"
eastrU(8) = " e oito"
eastrU(9) = " e nove"
eastrU(10) = " e dez"
eastrU(11) = " e onze"
eastrU(12) = " e doze"
eastrU(13) = " e treze"
eastrU(14) = " e quatorze"
eastrU(15) = " e quinze"
eastrU(16) = " e dezesseis"
eastrU(17) = " e dezessete"
eastrU(18) = " e dezoito"
eastrU(19) = " e dezenove"
eastrD(2) = " e vinte"
eastrD(3) = " e trinta"
eastrD(4) = " e quarenta"
eastrD(5) = " e cinqüenta"
eastrD(6) = " e sessenta"
eastrD(7) = " e setenta"
eastrD(8) = " e oitenta"
eastrD(9) = " e noventa"
eastrC(0) = ""
eastrC(1) = ", cento"
eastrC(2) = ", duzentos"
eastrC(3) = ", trezentos"
eastrC(4) = ", quatrocentos"
eastrC(5) = ", quinhentos"
eastrC(6) = ", seiscentos"
eastrC(7) = ", setecentos"
eastrC(8) = ", oitocentos"
eastrC(9) = ", novecentos"
Select Case Valor
Case 100
CDUExtenso = " e cem"
Case 0
CDUExtenso = ""
Case 1
CDUExtenso = "hum"
Case Else
estrValor = Format(Valor, "000")
CDUExtenso = eastrC(Val(Left(estrValor, 1)))
Select Case Val(Mid(estrValor, 2, 1))
Case 0, 1
CDUExtenso = CDUExtenso & eastrU(Val(Right(estrValor, 2)))
Case Else
CDUExtenso = CDUExtenso & eastrD(Val(Mid(estrValor, 2, 1)))
If Val(Right(estrValor, 1)) > 0 Then CDUExtenso = CDUExtenso & eastrU(Val(Right(estrValor, 1)))
End Select
End Select
End Function
'*************************************************************
' Função EXTENSO - MAIN FUNCTION - CALL THIS ONE
'*************************************************************
' Gabriel Tavares de Oliveira Castellani
'*************************************************************
' Retorna um valor por extenso
'*************************************************************
Function Extenso(ByVal Valor As Double) As String
Dim eastrInteiro() As String
Dim eastrMilhares() As String
Dim i As Integer, j As Integer
Dim estrTeste As String
Dim eastrParticula(0 To 2) As String
eastrParticula(0) = ""
eastrParticula(1) = " mil"
eastrParticula(2) = " milh"
eastrInteiro = Split(Format(Valor, "###,###,##0.00"), gstrSeparadorDecimal)
eastrMilhares = Split(eastrInteiro(0), gstrSeparadorMilhar)
estrTeste = ""
For i = 0 To UBound(eastrMilhares)
eastrMilhares(i) = CDUExtenso(eastrMilhares(i))
estrTeste = estrTeste & eastrMilhares(i)
Next
eastrInteiro(1) = CDUExtenso(eastrInteiro(1))
If estrTeste & eastrInteiro(1) = "" Then
Extenso = "zero reais"
Else
j = 0
For i = UBound(eastrMilhares) To 0 Step -1
If j = 2 Then
If Trim(eastrMilhares(i)) = "hum" Then
eastrParticula(j) = eastrParticula(j) & "ão"
Else
eastrParticula(j) = eastrParticula(j) & "ões"
End If
End If
Extenso = eastrMilhares(i) & eastrParticula(j) & Extenso
j = j + 1
Next
If Extenso = "hum" Then
Extenso = Extenso & " real"
Else
Extenso = Extenso & " reais"
End If
If eastrInteiro(1) <> "" Then
If eastrInteiro(1) = "hum" Then
Extenso = IIf(Extenso <> "", Extenso & " e um centavo", "hum centavo")
Else
Extenso = Extenso & eastrInteiro(1) & " centavos"
End If
End If
If Left(Extenso, 2) = " e" Or Left(Extenso, 2) = ", " Then Extenso = Right(Extenso, Len(Extenso) - 2)
Extenso = Trim(Extenso)
End If
End Function
'******************************************************
' USE THIS FOR AN EXAMPLE
'******************************************************
Private Sub Form_Click()
CarregaConfiguracoesRegionais
MsgBox Extenso(123.45)
End Sub
No comments have been posted about EXTENSO (Port.) - Converte n¨meros em valor por extenso (converts numbers into string with currency. Why not be the first to post a comment about EXTENSO (Port.) - Converte n¨meros em valor por extenso (converts numbers into string with currency.