Jump to content
Fórum Script Brasil
  • 0

Preciso de um código fonte para emitir nota promissória


Question

2 answers to this question

Recommended Posts

  • 0

Bom vamos dividir o problema em partes:

Valores por extenso:

Public Function EscrevePorExtenso(ByVal n As Double) As String
    Unid = Array("", "Um", "Dois", "Três", "Quatro", "Cinco", _
                 "Seis", "Sete", "Oito", "Nove", "Dez", "Onze", "Doze", _
                 "Treze", "Quatorze", "Quinze", "Dezesseis", "Dezessete", _
                 "Dezoito", "Dezenove", "Vinte")
    Dezen = Array("", "Dez", "Vinte", "Trinta", "Quarenta", _
                  "Cinquenta", "Sessenta", "Setenta", "Oitenta", "Noventa")
    Centen = Array("", "Cento", "Duzentos", "Trezentos", _
                   "Quatrocentos", "Quinhentos", "Seiscentos", _
                   "Setecentos", "Oitocentos", "Novecentos", "Mil")
    Num = n
    Escr = ""
    If n = 0 Then
        Escr = "Zero"
    End If
    If (n \ 1000) > 0 And n \ 1000 < 10 Then         Escr = Unid(n \ 1000) & " Mil "     End If     n = n - (n \ 1000) * 1000     If n > 100 Then
        Escr = Escr & Centen(n \ 100)
    End If
    If n = 100 Then
        Escr = Escr & " Cem"
        GoTo Prossiga
    End If
    n = n - (n \ 100) * 100
    If n >= 20 And n < 100 Then         Escr = Escr & " " & Dezen(n \ 10)     End If     If n > 0 And n < 20 Then         Escr = Escr & " " & Unid(n)         GoTo Prossiga     End If     n = n - (n \ 10) * 10     If n > 0 Then
        Escr = Escr & " " & Unid(n)
    End If
Prossiga:
    If Num Mod 10 <> 0 Then
        If InStr(1, Escr, "Vinte", 1) = 0 Then
            If InStr(1, Escr, "Trinta", 1) = 0 Then
                If InStr(1, Escr, "enta", 1) > 0 Then
                    Escr = Application.Substitute(Escr, "enta", "enta e ")
                End If
            End If
        End If
    End If
    If Num Mod 10 <> 0 Then
        If InStr(1, Escr, "Vinte", 1) > 0 Then
            If InStr(1, Escr, "Trinta", 1) = 0 Then
                If InStr(1, Escr, "enta", 1) = 0 Then
                    Escr = Application.Substitute(Escr, "Vinte", "Vinte e ")
                End If
            End If
        End If
    End If
    If Num Mod 10 <> 0 Then
        If InStr(1, Escr, "Vinte", 1) = 0 Then
            If InStr(1, Escr, "Trinta", 1) > 0 Then
                If InStr(1, Escr, "enta", 1) = 0 Then
                    Escr = Application.Substitute(Escr, "Trinta", "Trinta e ")
                End If
            End If
        End If
    End If
    If Num Mod 100 <> 0 Then
        If InStr(1, Escr, "ento", 1) > 0 Then
            Escr = Application.Substitute(Escr, "Cento", "Cento e ")
        End If
    End If
    If Num Mod 100 <> 0 Then
        If InStr(1, Escr, "entos", 1) > 0 Then
            Escr = Application.Substitute(Escr, "entos", "entos e ")
        End If
    End If
    If Num Mod 1000 <> 0 Then
        If (Num - (Num \ 1000) * 1000) <= 100 Then             If InStr(1, Escr, "Mil", 1) > 0 Then
                Escr = Application.Substitute(Escr, "Mil", "Mil e ")
            End If
        End If
    End If
End Function

Fonte: tomasvasquez

Link to post
Share on other sites
  • 0
22 horas atrás, Alyson Ronnan Martins disse:

Bom vamos dividir o problema em partes:

Valores por extenso:


Public Function EscrevePorExtenso(ByVal n As Double) As String
    Unid = Array("", "Um", "Dois", "Três", "Quatro", "Cinco", _
                 "Seis", "Sete", "Oito", "Nove", "Dez", "Onze", "Doze", _
                 "Treze", "Quatorze", "Quinze", "Dezesseis", "Dezessete", _
                 "Dezoito", "Dezenove", "Vinte")
    Dezen = Array("", "Dez", "Vinte", "Trinta", "Quarenta", _
                  "Cinquenta", "Sessenta", "Setenta", "Oitenta", "Noventa")
    Centen = Array("", "Cento", "Duzentos", "Trezentos", _
                   "Quatrocentos", "Quinhentos", "Seiscentos", _
                   "Setecentos", "Oitocentos", "Novecentos", "Mil")
    Num = n
    Escr = ""
    If n = 0 Then
        Escr = "Zero"
    End If
    If (n \ 1000) > 0 And n \ 1000 < 10 Then         Escr = Unid(n \ 1000) & " Mil "     End If     n = n - (n \ 1000) * 1000     If n > 100 Then
        Escr = Escr & Centen(n \ 100)
    End If
    If n = 100 Then
        Escr = Escr & " Cem"
        GoTo Prossiga
    End If
    n = n - (n \ 100) * 100
    If n >= 20 And n < 100 Then         Escr = Escr & " " & Dezen(n \ 10)     End If     If n > 0 And n < 20 Then         Escr = Escr & " " & Unid(n)         GoTo Prossiga     End If     n = n - (n \ 10) * 10     If n > 0 Then
        Escr = Escr & " " & Unid(n)
    End If
Prossiga:
    If Num Mod 10 <> 0 Then
        If InStr(1, Escr, "Vinte", 1) = 0 Then
            If InStr(1, Escr, "Trinta", 1) = 0 Then
                If InStr(1, Escr, "enta", 1) > 0 Then
                    Escr = Application.Substitute(Escr, "enta", "enta e ")
                End If
            End If
        End If
    End If
    If Num Mod 10 <> 0 Then
        If InStr(1, Escr, "Vinte", 1) > 0 Then
            If InStr(1, Escr, "Trinta", 1) = 0 Then
                If InStr(1, Escr, "enta", 1) = 0 Then
                    Escr = Application.Substitute(Escr, "Vinte", "Vinte e ")
                End If
            End If
        End If
    End If
    If Num Mod 10 <> 0 Then
        If InStr(1, Escr, "Vinte", 1) = 0 Then
            If InStr(1, Escr, "Trinta", 1) > 0 Then
                If InStr(1, Escr, "enta", 1) = 0 Then
                    Escr = Application.Substitute(Escr, "Trinta", "Trinta e ")
                End If
            End If
        End If
    End If
    If Num Mod 100 <> 0 Then
        If InStr(1, Escr, "ento", 1) > 0 Then
            Escr = Application.Substitute(Escr, "Cento", "Cento e ")
        End If
    End If
    If Num Mod 100 <> 0 Then
        If InStr(1, Escr, "entos", 1) > 0 Then
            Escr = Application.Substitute(Escr, "entos", "entos e ")
        End If
    End If
    If Num Mod 1000 <> 0 Then
        If (Num - (Num \ 1000) * 1000) <= 100 Then             If InStr(1, Escr, "Mil", 1) > 0 Then
                Escr = Application.Substitute(Escr, "Mil", "Mil e ")
            End If
        End If
    End If
End Function

Fonte: tomasvasquez

 

Muito Obrigado, fico no aguardo da outra parte

 

Deus Lhe Abençoe

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      148953
    • Total Posts
      645027
×
×
  • Create New...