DATA POR EXTENSO...

USUARIO.EXCLUIDOS 13/01/2005 15:23:01
#60549

alguem sabe ond encontro um exemplo de data por extenso dessa forma:
"aos treze dias do mês de janeiro do ano de dois mil e cinco"

casa nao haja... gostaria d saber ao menos como escrevo o ano por extenso

desde jah grato... abraços

USUARIO.EXCLUIDOS 13/01/2005 15:35:46
#60553

veja se funciona e depois avise:
você deve ter uma data 13/01/2005, com tres variaveis definidas como data formate sua data trez vezes

suadata = 13/01/2005
vardia = format(suadata,"dd")
varmes = format(suadata,"mmmm")
varano = format(suadata, "aaaa")
msgbox "aos " & vardia & " do mês de " & varmes & " do ano de " & varano
isso pensei agora e não tenho vb para testar, por isso se não funcionar nã me [S60]

LANCECOM 13/01/2005 15:36:06
#60554

suadata as date
suadata = format(suadata, "Long Date")

RE.NANER 13/01/2005 15:36:06
#60555 Resposta escolhida

Fala aeee!!

Esta função Ã© para escrever valores por extenso, mas vc pode fazer algumas modificações, pois se digitar 2004, vai aparecer : Dois Mil e Quatro Reais

Public Function numeroExtenso(vNumero As Variant, Optional bMoeda As Boolean = True) As String

    Dim iContador As Integer
    Dim iTamanho As Integer
    
    Dim sValor As String
    Dim sParte As String
    Dim sFinal As String
    
    If IsNull(vNumero) Or vNumero <= 0 Or vNumero > 9999999.99 Or Not IsNumeric(vNumero) Then Exit Function
    
    ReDim matGrupo(4), matTexto(4) As String

    ReDim matUnidades(19) As String
    matUnidades(1) = "Um "
    matUnidades(2) = "Dois "
    matUnidades(3) = "Tres "
    matUnidades(4) = "Quatro "
    matUnidades(5) = "Cinco "
    matUnidades(6) = "Seis "
    matUnidades(7) = "Sete "
    matUnidades(8) = "Oito "
    matUnidades(9) = "Nove "
    matUnidades(10) = "Dez "
    matUnidades(11) = "Onze "
    matUnidades(12) = "Doze "
    matUnidades(13) = "Treze "
    matUnidades(14) = "Quatorze "
    matUnidades(15) = "Quinze "
    matUnidades(16) = "Dezesseis "
    matUnidades(17) = "Dezessete "
    matUnidades(18) = "Dezoito "
    matUnidades(19) = "Dezenove "
    
    ReDim matDezenas(9) As String
    matDezenas(1) = "Dez "
    matDezenas(2) = "Vinte "
    matDezenas(3) = "Trinta "
    matDezenas(4) = "Quarenta "
    matDezenas(5) = "Cinquenta "
    matDezenas(6) = "Sessenta "
    matDezenas(7) = "Setenta "
    matDezenas(8) = "Oitenta "
    matDezenas(9) = "Noventa "
    
    ReDim matCentenas(9) As String
    matCentenas(1) = "Cento "
    matCentenas(2) = "Duzentos "
    matCentenas(3) = "Trezentos "
    matCentenas(4) = "Quatrocentos "
    matCentenas(5) = "Quinhentos "
    matCentenas(6) = "Seiscentos "
    matCentenas(7) = "Setecentos "
    matCentenas(8) = "Oitocentos "
    matCentenas(9) = "Novecentos "
    
    sValor = Format(vNumero, "0000000000.00")
    matGrupo(1) = Mid(sValor, 2, 3)
    matGrupo(2) = Mid(sValor, 5, 3)
    matGrupo(3) = Mid(sValor, 8, 3)
    matGrupo(4) = "0" + Mid(sValor, 12, 2)
    
    For iContador = 1 To 4

      sParte = matGrupo(iContador)

      iTamanho = Switch(Val(sParte) < 10, 1, Val(sParte) < 100, 2, Val(sParte) < 1000, 3)

      If iTamanho = 3 Then
        If Right(sParte, 2) <> "00" Then
          matTexto(iContador) = matTexto(iContador) + matCentenas(Left(sParte, 1)) + "e "
          iTamanho = 2
        Else
          matTexto(iContador) = matTexto(iContador) + IIf(Left(sParte, 1) = "1", "Cem ", _
          matCentenas(Left(sParte, 1)))
        End If
      End If

      If iTamanho = 2 Then
        If Val(Right(sParte, 2)) < 20 Then
          matTexto(iContador) = matTexto(iContador) + matUnidades(Right(sParte, 2))
        Else
          matTexto(iContador) = matTexto(iContador) + matDezenas(Mid(sParte, 2, 1))
          If Right(sParte, 1) <> "0" Then
            matTexto(iContador) = matTexto(iContador) + "e "
            iTamanho = 1
          End If
        End If
      End If

      If iTamanho = 1 Then
        matTexto(iContador) = matTexto(iContador) + matUnidades(Right(sParte, 1))
      End If

    Next

    If Val(matGrupo(1) + matGrupo(2) + matGrupo(3)) = 0 And Val(matGrupo(4)) <> 0 Then
      sFinal = matTexto(4) + IIf(Val(matGrupo(4)) = 1, "centavo", "centavos")
    Else
      sFinal = ""
      sFinal = sFinal + IIf(Val(matGrupo(1)) <> 0, matTexto(1) + IIf(Val(matGrupo(1)) > 1, _
               "milhões ", "milhão "), "")
      
      If Val(matGrupo(2) + matGrupo(3)) = 0 Then
        sFinal = sFinal + "de "
      Else
        sFinal = sFinal + IIf(Val(matGrupo(2)) <> 0, matTexto(2) + "Mil ", "")
      End If
      
      If Not bMoeda Then
          sFinal = sFinal + matTexto(3) + IIf(Val(matGrupo(4)) <> 0, "Virgula " + matTexto(4), "")
      Else
        sFinal = sFinal + matTexto(3) + IIf(Val(matGrupo(1) + matGrupo(2) + matGrupo(3)) = 1, "real ", _
                  "reais ")
        sFinal = sFinal + IIf(Val(matGrupo(4)) <> 0, "e " + matTexto(4) + IIf(Val(matGrupo(4)) = 1, _
                 "centavo", "centavos"), "")
        End If

    End If

    numeroExtenso = sFinal

End Function

Private Sub Command1_Click()
'**Chamada da Função
Text1.Text = numeroExtenso(Text1.Text)
End Sub

Espero ter ajudado..

Falowss

RE.NANER 13/01/2005 15:43:36
#60562

Wiliam
Subtitui a linha

varano = Format(suadata, "aaaa")
varano = Format(suadata, "yyyy")

Mas o resultado fica assim: aos 13 do mês de janeiro do ano de 2005

Falwos

RE.NANER 13/01/2005 15:50:26
#60566

Public Function numeroExtenso(vNumero As Variant, Optional bMoeda As Boolean = True) As String

    Dim iContador As Integer
    Dim iTamanho As Integer
    
    Dim sValor As String
    Dim sParte As String
    Dim sFinal As String
    
    If IsNull(vNumero) Or vNumero <= 0 Or vNumero > 9999999.99 Or Not IsNumeric(vNumero) Then Exit Function
    
    ReDim matGrupo(4), matTexto(4) As String

    ReDim matUnidades(19) As String
    matUnidades(1) = "Um "
    matUnidades(2) = "Dois "
    matUnidades(3) = "Tres "
    matUnidades(4) = "Quatro "
    matUnidades(5) = "Cinco "
    matUnidades(6) = "Seis "
    matUnidades(7) = "Sete "
    matUnidades(8) = "Oito "
    matUnidades(9) = "Nove "
    matUnidades(10) = "Dez "
    matUnidades(11) = "Onze "
    matUnidades(12) = "Doze "
    matUnidades(13) = "Treze "
    matUnidades(14) = "Quatorze "
    matUnidades(15) = "Quinze "
    matUnidades(16) = "Dezesseis "
    matUnidades(17) = "Dezessete "
    matUnidades(18) = "Dezoito "
    matUnidades(19) = "Dezenove "
    
    ReDim matDezenas(9) As String
    matDezenas(1) = "Dez "
    matDezenas(2) = "Vinte "
    matDezenas(3) = "Trinta "
    matDezenas(4) = "Quarenta "
    matDezenas(5) = "Cinquenta "
    matDezenas(6) = "Sessenta "
    matDezenas(7) = "Setenta "
    matDezenas(8) = "Oitenta "
    matDezenas(9) = "Noventa "
    
    ReDim matCentenas(9) As String
    matCentenas(1) = "Cento "
    matCentenas(2) = "Duzentos "
    matCentenas(3) = "Trezentos "
    matCentenas(4) = "Quatrocentos "
    matCentenas(5) = "Quinhentos "
    matCentenas(6) = "Seiscentos "
    matCentenas(7) = "Setecentos "
    matCentenas(8) = "Oitocentos "
    matCentenas(9) = "Novecentos "
    
    sValor = Format(vNumero, "0000000000.00")
    matGrupo(1) = Mid(sValor, 2, 3)
    matGrupo(2) = Mid(sValor, 5, 3)
    matGrupo(3) = Mid(sValor, 8, 3)
    matGrupo(4) = "0" + Mid(sValor, 12, 2)
    
    For iContador = 1 To 4

      sParte = matGrupo(iContador)

      iTamanho = Switch(Val(sParte) < 10, 1, Val(sParte) < 100, 2, Val(sParte) < 1000, 3)

      If iTamanho = 3 Then
        If Right(sParte, 2) <> "00" Then
          matTexto(iContador) = matTexto(iContador) + matCentenas(Left(sParte, 1)) + "e "
          iTamanho = 2
        Else
          matTexto(iContador) = matTexto(iContador) + IIf(Left(sParte, 1) = "1", "Cem ", _
          matCentenas(Left(sParte, 1)))
        End If
      End If

      If iTamanho = 2 Then
        If Val(Right(sParte, 2)) < 20 Then
          matTexto(iContador) = matTexto(iContador) + matUnidades(Right(sParte, 2))
        Else
          matTexto(iContador) = matTexto(iContador) + matDezenas(Mid(sParte, 2, 1))
          If Right(sParte, 1) <> "0" Then
            matTexto(iContador) = matTexto(iContador) + "e "
            iTamanho = 1
          End If
        End If
      End If

      If iTamanho = 1 Then
        matTexto(iContador) = matTexto(iContador) + matUnidades(Right(sParte, 1))
      End If

    Next

    If Val(matGrupo(1) + matGrupo(2) + matGrupo(3)) = 0 And Val(matGrupo(4)) <> 0 Then
      sFinal = matTexto(4) + IIf(Val(matGrupo(4)) = 1, "centavo", "centavos")
    Else
      sFinal = ""
      sFinal = sFinal + IIf(Val(matGrupo(1)) <> 0, matTexto(1) + IIf(Val(matGrupo(1)) > 1, _
               "milhões ", "milhão "), "")
      
      If Val(matGrupo(2) + matGrupo(3)) = 0 Then
        sFinal = sFinal + "de "
      Else
        sFinal = sFinal + IIf(Val(matGrupo(2)) <> 0, matTexto(2) + "Mil ", "")
      End If
      
      If Not bMoeda Then
          sFinal = sFinal + matTexto(3) + IIf(Val(matGrupo(4)) <> 0, "Virgula " + matTexto(4), "")
      Else
        sFinal = sFinal + matTexto(3) '+ IIf(Val(matGrupo(1) + matGrupo(2) + matGrupo(3)) = 1, "")
                  
        sFinal = sFinal + IIf(Val(matGrupo(4)) <> 0, "e " + matTexto(4) + IIf(Val(matGrupo(4)) = 1, _
                 "centavo", "centavos"), "")
      End If

    End If

    numeroExtenso = sFinal

End Function

USUARIO.EXCLUIDOS 13/01/2005 16:11:21
#60576

vlw re_naner...

certinho... jah me ajudou... com isso eu faco o resto...

vlw galera...

duvida sanada... topico encerrado

Página única

Tópico encerrado , respostas não são mais permitidas

Voltar