Codigo por extenso no excel
306 palavras
2 páginas
Function fExtenso(Num As Double, Optional FraçTipo As Integer, Optional UndNomeSing As String, _ Optional UndNomePlur As String, Optional UndMasc As Boolean = True, _ Optional UmMil 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 As String 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ção Pluralizar 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çTipo Case 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 ou plural 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")))