MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


4 participantes

    Remove os nomes do meio, preservando os primeiros e o último nome

    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3936
    Registrado : 21/04/2011

    Remove os nomes do meio, preservando os primeiros e o último nome Empty Remove os nomes do meio, preservando os primeiros e o último nome

    Mensagem  Marcelo David 31/5/2023, 20:25

    Inspirado nesse tópico: https://www.maximoaccess.com/t42091-vba-extrair-nome-apelido-e-nomes-do-meio
    apresento-lhes uma função que retorna os primeiros nomes e o último e remove as preposições. Exemplo:
    Nome: Maria Eugénia do Carmo Mendonça Teixeira Fernandes - possui 50 caracteres.

    Mas quero que seja reduzido para apenas 30 caracteres, preservando os primeiros nomes e o último, ficando assim:

    Mara Eugénia Carmo Fernandes.

    Basta aplicar a função:

    ReduzNomes("Maria Eugénia do Carmo Mendonça Teixeira Fernandes", 30)

    Será retornado: Mara Eugénia Carmo Fernandes

    Notem que a quantidade de caracteres pode ser a que vocês determinarem no parâmetro. Nesse exemplo foi 30.

    Obs.: A função também trata espaços vazios, deixando apenas um espaço entre palavras e remove espaços do inicio e fim.

    E como se trata de uma função publica, poderá utilizar inclusive em uma consulta.

    Código:
    'Autor: Marcelo David
    'Data: 31/05/2023
    'Propósito: Reduz um nome para uma quantidade definida de caracteres, preservando palavras completas e
    'e sempre retornando os primeimeiros nomes e o último nome/palavra
    '----------------------------------------------------------------------------------
    'Parâmetros -----------------------------------------------------------------------
    'strNome: o nome que será reduzido
    'iQuantidadeCaracteres: o limite máximo de caracteres que será retornado
    'Exemplo: -------------------------------------------------------------------------
    'No nome "Marcelo Rocha Vascocelos Romero dos Santos Consta David", que possue 55 caracteres e eu deseje
    'retonar até 25 caracteres, basta chamar a função passando para uma variável ou qualquer outro objeto.
    'Nesse exemplo, quero passar o retorno para uma Caixa de Texto (TextBox) chamada TxtNome:
    'Me.TxtNome = ReduzNomes("Marcelo Rocha Vascocelos Romero dos Santos Consta David", 25)
    'A Caixa de texto receberá: Marcelo Rocha David, pois há 19 caracteres e o próxim nome já passaria dos
    '25 caracteres definidos
    Public Function ReduzNomes(strNome As String, iQuantidadeCaracteres As Integer) As String
       Dim vNomes() As String
       Dim i As Integer
       Dim r As String
       Dim ra As String
       
       'Removo espaços a direita e esquerda
       strNome = Trim(strNome)
       
       'Já passo a atrubuo o valor do pamêtro strNome para a função, assim mesmo que a quantidade de caracteres
       'seja igual ou menos que iQuantidadeCaracteres a função terá valor
       ReduzNomes = strNome

       'Caso o nome tenha até quantidade definida em iQuantidadeCaracteres, não executa a sub
       If Len(strNome) <= iQuantidadeCaracteres Then Exit Function

       'Separo os nomes
       vNomes = Split(strNome)
       'Percorro os elementos da matriz (nomes) para montar o nome final
       For i = LBound(vNomes) To UBound(vNomes)
           'Só incluo nomes e não preposição
           If vNomes(i) <> "dos" And vNomes(i) <> "do" And vNomes(i) <> "da" And vNomes(i) <> "das" And vNomes(i) <> "de" And vNomes(i) <> "e" And Not IsEmpty(vNomes(i)) Then
               ra = Trim(ra) & " " & vNomes(i)
               If Len(ra & " " & vNomes(UBound(vNomes))) <= iQuantidadeCaracteres Then
                   r = Trim(ra) & " " & vNomes(UBound(vNomes))
               End If
           End If
       Next
       ReduzNomes = r
    End Function


    Última edição por Marcelo David em 1/6/2023, 00:20, editado 2 vez(es) (Motivo da edição : Atualização da função - remover espaços desnecessários)


    .................................................................................
    Remove os nomes do meio, preservando os primeiros e o último nome Favicon-16x16   Domine Access e VBA Criando Um Incrível Sistema Financeiro - [Passo a passo]
    Remove os nomes do meio, preservando os primeiros e o último nome Favicon-16x16   Access e VBA - Formulário Desacoplado - [Passo a passo]
    Remove os nomes do meio, preservando os primeiros e o último nome Yt_16x10 Conheça meu canal no Youtube e se inscreva.
    Remove os nomes do meio, preservando os primeiros e o último nome Marcel11
    Mylton
    Mylton
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1040
    Registrado : 23/08/2010

    Remove os nomes do meio, preservando os primeiros e o último nome Empty Re: Remove os nomes do meio, preservando os primeiros e o último nome

    Mensagem  Mylton 31/5/2023, 21:11

    Parabéns
    Será útil com certeza.

    Marcelo David gosta desta mensagem

    avatar
    jhbf
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 37
    Registrado : 21/06/2016

    Remove os nomes do meio, preservando os primeiros e o último nome Empty Re: Remove os nomes do meio, preservando os primeiros e o último nome

    Mensagem  jhbf 31/5/2023, 22:07

    Parabéns, Marcelo David!

    A função está excelente! cheers cheers

    Vai ajudar muita gente!


    Vou pedir a sua ajuda no tópico original.

    Marcelo, volto a agradecer o excelente trabalho realizado.

    Muito Obrigado!

    Marcelo David gosta desta mensagem

    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7970
    Registrado : 15/03/2013

    Remove os nomes do meio, preservando os primeiros e o último nome Empty Re: Remove os nomes do meio, preservando os primeiros e o último nome

    Mensagem  Alvaro Teixeira 2/6/2023, 14:51

    Olá Marcelo David,

    Parabéns pelo exemplo e partilha "do desafio" Laughing

    Abraço

    Marcelo David e ribeiroguaruja gostam desta mensagem


    Conteúdo patrocinado


    Remove os nomes do meio, preservando os primeiros e o último nome Empty Re: Remove os nomes do meio, preservando os primeiros e o último nome

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 3/10/2024, 10:56