Re: [pt-br-usuarios] Data em formato txt

Ola Jorge, usei a função NEXTENSO desenvolvida por: Noelson Alves Duarte 
e Gustavo Buzzatti Pacheco em 
'https://wiki.documentfoundation.org/Extensions/Projects/NumExtenso/pt-br

para não dar confusão alterei para DEXTENSO para datas.

Copiar as Macros abaixo para sua planilha:

------------------------------------------------------------------------

REM  *****  BASIC  *****

REM  *****  BASIC  *****
'https://wiki.documentfoundation.org/Extensions/Projects/NumExtenso/pt-br
'desenvolvida por: Noelson Alves Duarte e Gustavo Buzzatti Pacheco
'adaptada para data por: Gilberto Schiavinatto

function DExtenso(byval dValor as double) as string
'    nextenso=extenso(dvalor,"reais", "real")
    dextenso=extenso(dvalor,"", "")
end Function

function Extenso(ByVal Valor As Double, ByVal MoedaPlural As String, 
ByVal MoedaSingular As String) As String
  Dim StrValor As String, Negativo As Boolean
  Dim Buf As String, Parcial As Integer
  Dim Temp as string
  Dim Posicao As Integer, Unidades
  Dim Dezenas, Centenas, PotenciasSingular
  Dim PotenciasPlural

  Negativo = (Valor < 0)
  Valor = Abs((Valor))
  If Valor Then
    Unidades = Array(vbNullString, "um", "dois", "três", "quatro", 
"cinco", "seis", "sete", "oito", "nove",  "dez", "onze", "doze", 
"treze", "quatorze", "quinze", "dezesseis", "dezessete", "dezoito", 
"dezenove")
    Dezenas = Array(vbNullString, vbNullString, "vinte", "trinta", 
"quarenta", "cinquenta", "sessenta", "setenta", "oitenta", "noventa")
    Centenas = Array(vbNullString, "cento", "duzentos", "trezentos", 
"quatrocentos", "quinhentos", "seiscentos", "setecentos", "oitocentos", 
"novecentos")
    PotenciasSingular = Array(vbNullString, " mil", " milhão", " 
bilhão", " trilhão", " quatrilhão")
    PotenciasPlural = Array(vbNullString, " mil", " milhões", " 
bilhões", " trilhões", " quatrilhões")
    StrValor = Left(Format(Valor, String(18, "0") & ".000"), 18)

    For Posicao = 1 To 18 Step 3
      Parcial = Val(Mid(StrValor, Posicao, 3))
      If Parcial Then
        If Parcial = 1 Then
          Buf = "um" & PotenciasSingular((18 - Posicao) \ 3)
        ElseIf Parcial = 100 Then
          Buf = "cem" & PotenciasSingular((18 - Posicao) \ 3)
        Else
          Buf = Centenas(Parcial \ 100)
          Parcial = Parcial Mod 100
          If Parcial <> 0 And Buf <> vbNullString Then
            Buf = Buf & " e "
          End If
          If Parcial < 20 Then
            Buf = Buf & Unidades(Parcial)
          Else
            Buf = Buf & Dezenas(Parcial \ 10)
            Parcial = Parcial Mod 10
            If Parcial <> 0 And Buf <> vbNullString Then
              Buf = Buf & " e "
            End If
            Buf = Buf & Unidades(Parcial)
          End If
          Buf = Buf & PotenciasPlural((18 - Posicao) \ 3)
        End If
        If Buf <> vbNullString Then
          If Temp <> vbNullString Then
            Parcial = Val(Mid(StrValor, Posicao, 3))
            If Posicao = 16 And (Parcial < 100 Or _
                (Parcial Mod 100) = 0) Then
              Temp = Temp & " e "
            Else
              Temp = Temp & ", "
            End If
          End If
          Temp = Temp & Buf
        End If
      End If
    Next
    If Temp <> vbNullString Then
      If Negativo Then
        Temp = "menos " & Temp
      End If
      If Int(Valor) = 1 Then
        Temp = Temp & " " & MoedaSingular
      Else
        Temp = Temp & " " & MoedaPlural
      End If
    End If
    Parcial = Int((Valor - Int(Valor)) * 100 + 0.1)
    If Parcial Then
'      Buf = ExtensoCentavos(Parcial, "centavos", "centavo")
       Buf = ExtensoCentavos(Parcial, "", "")
      If Temp <> vbNullString Then
        Temp = Temp & " e "
      End If
      Temp = Temp & Buf
    End If
  End If
  Extenso = Temp
End function

function ExtensoCentavos(ByVal Valor As Double, ByVal MoedaPlural As 
String, ByVal MoedaSingular As String) As String
  Dim StrValor As String, Negativo As Boolean
  Dim Buf As String, Parcial As Integer
  Dim Temp as string
  Dim Posicao As Integer, Unidades
  Dim Dezenas, Centenas, PotenciasSingular
  Dim PotenciasPlural

  Negativo = (Valor < 0)
  Valor = Abs((Valor))
  If Valor Then
    Unidades = Array(vbNullString, "um", "dois", "três", "quatro", 
"cinco", "seis", "sete", "oito", "nove",  "dez", "onze", "doze", 
"treze", "quatorze", "quinze", "dezesseis", "dezessete", "dezoito", 
"dezenove")
    Dezenas = Array(vbNullString, vbNullString, "vinte", "trinta", 
"quarenta", "cinquenta", "sessenta", "setenta", "oitenta", "noventa")
    Centenas = Array(vbNullString, "cento", "duzentos", "trezentos", 
"quatrocentos", "quinhentos", "seiscentos", "setecentos", "oitocentos", 
"novecentos")
    PotenciasSingular = Array(vbNullString, " mil", " milhão", " 
bilhão", " trilhão", " quatrilhão")
    PotenciasPlural = Array(vbNullString, " mil", " milhões", " 
bilhões", " trilhões", " quatrilhões")

    StrValor = Left(Format(Valor, String(18, "0") & ".000"), 18)

    For Posicao = 1 To 18 Step 3
      Parcial = Val(Mid(StrValor, Posicao, 3))
      If Parcial Then
        If Parcial = 1 Then
          Buf = "um" & PotenciasSingular((18 - Posicao) \ 3)
        ElseIf Parcial = 100 Then
          Buf = "cem" & PotenciasSingular((18 - Posicao) \ 3)
        Else
          Buf = Centenas(Parcial \ 100)
          Parcial = Parcial Mod 100
          If Parcial <> 0 And Buf <> vbNullString Then
            Buf = Buf & " e "
          End If
          If Parcial < 20 Then
            Buf = Buf & Unidades(Parcial)
          Else
            Buf = Buf & Dezenas(Parcial \ 10)
            Parcial = Parcial Mod 10
            If Parcial <> 0 And Buf <> vbNullString Then
              Buf = Buf & " e "
            End If
            Buf = Buf & Unidades(Parcial)
          End If
          Buf = Buf & PotenciasPlural((18 - Posicao) \ 3)
        End If
        If Buf <> vbNullString Then
          If Temp <> vbNullString Then
            Parcial = Val(Mid(StrValor, Posicao, 3))
            If Posicao = 16 And (Parcial < 100 Or _
                (Parcial Mod 100) = 0) Then
              Temp = Temp & " e "
            Else
              Temp = Temp & ", "
            End If
          End If
          Temp = Temp & Buf
        End If
      End If
    Next
    If Temp <> vbNullString Then
      If Negativo Then
        Temp = "menos " & Temp
      End If
      If Int(Valor) = 1 Then
        Temp = Temp & " " & MoedaSingular
      Else
        Temp = Temp & " " & MoedaPlural
      End If
    End If
    Parcial = Int((Valor - Int(Valor)) * 100 + 0.1)
    If Parcial Then
      Buf = Extenso(Parcial, "centavos", "centavo")
      If Temp <> vbNullString Then
        Temp = Temp & " e "
      End If
      Temp = Temp & Buf
    End If
  End If
  ExtensoCentavos = Temp
End function

------------------------------------------------------------------------

Só alterei as linhas sobre Real / Reais / Centavo e Centavos para não 
mostrar.

considerando a data na célula*E4**
*
a formula é esta:
*
**=DEXTENSO(DIA(E4))&" de 
"&ESCOLHER(MÊS(E4);"janeiro";"fevereiro";"março";"abril";"maio";"junho";"julho";"agosto";"setembro";"outubro";"novembro";"dezembro")&" 
de "&DEXTENSO(ANO(E4))*

Só não consegui ser na mesma célula digitada.




Em 18/09/2018 14:36, Jorge Fernandes escreveu:
> Boa tarde
> Como faz pra data xx/××/×××× ser convertida imediatamente em extenso ( dois
> de maio de mil novecentos e setenta e seis)?
> Pode ser em outra planilha no mesmo arquivo, sem problema.
> Obrigado


--
Você está recebendo e-mails da lista usuarios@pt-br.libreoffice.org
# Informações sobre os comandos disponíveis (em inglês):
 mande e-mail vazio para usuarios+unsubscribe@pt-br.libreoffice.org
# Cancelar sua assinatura: mande e-mail vazio para:
 usuarios+unsubscribe@pt-br.libreoffice.org
# Arquivo de mensagens: https://listarchives.libreoffice.org/pt-br/usuarios/