Início
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.
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)
