Ir para conteúdo
Fórum Script Brasil
  • 0

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


geraldo pereira

Pergunta

2 respostass a esta questão

Posts Recomendados

  • 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 para o comentário
Compartilhar em outros 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 para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,7k
×
×
  • Criar Novo...