a b c d e

Function Extenso_Valor(valor As Double) As String Dim strMoeda As String Dim cents As Variant Dim decimalSep As String

' Se o valor for igual ou maior que 1 quatrilhao
' passar erro e sair da funcao If valor > 999999999999999# Then Extenso_Valor = "Valor excede 999.999.999.999.999" Exit Function End If

' Se valor for igual a 1, a unidade está no singular If WorksheetFunction.RoundDown(valor, 0) = 1 Then
' a string da moeda no singular strMoeda = " real"
' Se for maior que 1 a unidade está no plural ElseIf WorksheetFunction.RoundDown(valor, 0) > 1 Then strMoeda = " reais" End If ' Remove os centavos cents = valor - WorksheetFunction.RoundDown(valor, 0)
' Remove os centavos do valor valor = valor - CDbl(cents)
' Passo o extenso dos centavos cents = centavos(CDbl(cents) * 100)
' End If
' Caso a string seja diferente de branco e valor seja maior ou igual a 1 If cents "" And valor >= 1 Then
' acrescentar uma vírgula antes do extenso cents = " e " & cents End If
' Iniciar o processo de conversao dos valores longos strMoeda = Trim(Trilhoes(valor)) & strMoeda & cents strMoeda = Replace(strMoeda, ", e", " e") strMoeda = Replace(strMoeda, ", r", " r") If Left(strMoeda, 2) = "e " Then strMoeda = Mid(strMoeda, 3, Len(strMoeda)) 'ElseIf Left(strMoeda, 5) = "mil e" Then ' strMoeda = Mid(strMoeda, 5, Len(strMoeda)) End If vzz = "00000000000000000000" vtam = Len(Trim(Mid(Trim(valor), 2, 100))) If Right(vzz + vzz + vzz + vzz, vtam) = Mid(Trim(valor), 2, 100) And InStr(UCase(strMoeda), UCase("es ")) > 0 Then vetor = Split(strMoeda, " ") vtrocar = vetor(UBound(vetor)) strMoeda = Replace(strMoeda, vtrocar, "de " + vtrocar) End If

Extenso_Valor = strMoeda

End