Codigo por extenso no excel

Disponível somente no TrabalhosFeitos
  • Páginas : 2 (306 palavras )
  • Download(s) : 0
  • Publicado : 5 de setembro de 2012
Ler documento completo
Amostra do texto
Function fExtenso(Num As Double, Optional FraçTipo As Integer, Optional UndNomeSing As String, _
Optional UndNomePlur As String, Optional UndMasc As Boolean = True, _
OptionalUmMil As Boolean = True, Optional VirgEntrMilh As Boolean = False, _
Optional CaixaAlta As Long = 1) As String
Dim ExtensInt As String
Dim ExtensFrac As String
Dim UndNome AsString
Dim FracNome As String
Dim Signif As Long
Dim NumText As String

If Num > 999999999999.99 Or Num < 0 Then
fExtenso = "Erro! (Valores válidos: >=0 e < 1 trilhão)"Exit Function
End If

'Preparando nome da unidade, singular e plural
If UndNomePlur = "" Then UndNomePlur = IIf(UndNomeSing = "", "", Pluralizar(UndNomeSing))
'Se a funçãoPluralizar falhar palavras estrangeiras ou em exceções portuguesas, o argumento UndNomePlur pode ser usado.

'Extenso parte inteira
ExtensInt = fExtensoInt(Int(CDec(Num)), UndMasc,UmMil, VirgEntrMilh)

'Extenso parte fracionária
If FraçTipo = 0 And UndNomeSing = "" Then FraçTipo = 3
If FraçTipo = 0 And UndNomeSing "" Then FraçTipo = 1
Select Case FraçTipoCase 1, 5 'Lê fração em centavos ou cêntimos. Ideal para Moeda
Num = Format(Num, "0.00") * 1 'Round(Num,2)
ExtensFrac = fExtensoInt((Num - Int(CDec(Num))) * 100, True, UmMil,VirgEntrMilh)
If ExtensInt = "" And ExtensFrac = "" Then ExtensInt = "zero"

'Nome da unidade no singular ou plural
UndNome = IIf(Num < 1, IIf(Num = 0, " " & UndNomePlur,""), IIf(UndNomeSing = "" Or Right(ExtensInt, 1) = " ", "", " ") & IIf(Int(CDec(Num)) = 1, UndNomeSing, UndNomePlur) & IIf(Num = Int(CDec(Num)), "", " e "))
'Nome da fração no singular ouplural
FracNome = IIf(Num = Int(CDec(Num)), "", IIf(Int(CDec(Num * 100)) - Int(CDec(Num)) * 100 = 1, IIf(FraçTipo = 5, " cêntimo", " centavo"), IIf(FraçTipo = 5, " cêntimos", " centavos")))...
tracking img