Extenso -alguém Tem Formula De Extenso

[RINGO]

Boa tarde.

Alguém tem uma formula de extenso para o excel.

E como coloar a formular para rodar em todas a planilha

[Guest Air]

Olá novato,

segue extenso

Dim um_a_19

Dim Dezenas

Dim Centenas

Sub carregaVars()

um_a_19 = Array("", "Um", "Dois", "Três", "Quatro", "Cinco", _

"Seis", "Sete", "Oito", "Nove", "Dez", _

"Onze", "Doze", "Treze", "Quatorze", _

"Quinze", "Dezesseis", "Dezessete", _

"Dezoito", "Dezenove")

Dezenas = Array("", "Dez", _

"Vinte", "Trinta", "Quarenta", "Cinquenta", _

"Sessenta", "Setenta", "Oitenta", "Noventa")

Centenas = Array("Cem", "Cento", "Duzentos", "Trezentos", "Quatrocentos", _

"Quinhentos", "Seiscentos", "Setecentos", _

"Oitocentos", "Novecentos")

End Sub

Function Processa(num) As String

'Rotina utilizada para processar

'parcelas de um numero

'dividido em três posições

Dim n

n = Format(num, "000")

a1 = Val(Mid(n, 1, 1))

a2 = Val(Mid(n, 2, 1))

a3 = Val(Mid(n, 3, 1))

If a1 <> 0 And a2 & a3 = "00" Then

If Val(a1 & a2 & a3) > 100 Then

Processa = Centenas(a1)

Else

Processa = Centenas(a1 - 1)

End If

ElseIf a1 > 0 And a2 >= 0 Then

Select Case a3

Case Is > 0

If Val(a2 & a3) > 19 Then

Processa = Centenas(a1) & " e " & _

Dezenas(a2) & " e " & _

um_a_19(a3)

Else

Processa = Centenas(a1) & " e " & _

um_a_19(Val(a2 & a3))

End If

Case Is = 0

Processa = Centenas(a1) & " e " & Dezenas(a2)

End Select

ElseIf a1 = 0 Then

Select Case Val(a2 & a3)

Case Is < 20

Processa = um_a_19(Val(a2 & a3))

Case Else

If um_a_19(a3) = "" Then

Processa = Dezenas(a2)

Else

Processa = Dezenas(a2) & " e " & _

um_a_19(a3)

End If

End Select

Else

Processa = ""

End If

End Function

'

'

'

'

Function xExtenso(numero As Double) As String

Dim ExtensoTemp As String

Dim XMilhoes, XMilhares, XCentenas, Centavos

Dim moeda1 As String, moeda2 As String, sep As String

Dim v1 As Boolean, v2 As Boolean

Call carregaVars

If numero > 999999999.99 Then

Extenso = "Erro - valor superior ao maximo:999.999.999,99"

Exit Function

End If

num = Format(numero, "000000000.00")

XMilhoes = Processa(Mid(num, 1, 3))

XMilhares = Processa(Mid(num, 4, 3))

XCentenas = Processa(Mid(num, 7, 3))

Centavos = Right(num, 2)

v1 = False

If Val(Mid(num, 1, 9)) > 0 Then

moeda1 = " Reais "

v1 = True

End If

v2 = False

If Val(Centavos) > 0 Then

moeda2 = " Centavos "

v2 = True

End If

If v1 = True And v2 = True Then sep = "e "

Select Case Centavos

Case Is <= 19

extCentavos = um_a_19(Centavos)

Case Is >= 20

extCentavos = Dezenas(Left(Centavos, 1)) & " " & um_a_19(Right(Centavos, 1))

End Select

If XMilhoes > "" Then

If XMilhoes = "Um" Then

ExtensoTemp = ExtensoTemp & XMilhoes & " milhão "

Else

ExtensoTemp = ExtensoTemp & XMilhoes & " milhões "

End If

End If

If XMilhares > "" Then

If XMilhares = "um" And XMilhoes = "" Then

ExtensoTemp = ExtensoTemp & "mil "

Else

ExtensoTemp = ExtensoTemp & XMilhares & " mil "

End If

End If

If XCentenas > "" Then ExtensoTemp = ExtensoTemp & XCentenas

ExtensoTemp = ExtensoTemp & moeda1 & sep & extCentavos & moeda2

xExtenso = LCase(ExtensoTemp)

End Function