Olá, Amigos.

Preciso de uma ajuda, estava com um duvida para saber como se abreviava nomes do meio numa célula no Excel, achei um excelente Código de autoria de Adilson Soledade moderador da comunidade, porém gostaria de saber se teria como o código VBA fornecer as abreviações mas sem os pontos, nome completo (José Anchieta Santos Neves) o código fornece assim(José A. S. Neves), gostaria sem os pontos(José A S Neves). Desde já agradeço pela ajuda.

Function ABREVIARNOMES(Célula As Range, ParamArray NomesSemAbreviar()) As String
Dim PrimeiroNome As String, Texto As String, _
ÚltimoNome As String, Abrev As String
Dim i As Integer, k As Integer, Opcional As Integer, Controle As Integer
Dim Nome, Nomes, NomeSemAbreviar, PosiçãoInicial

Application.Volatile


'Se só houver uma palavra, somente ela é retornada
Texto = Célula
If InStr(1, Texto, " ") = 0 Then
ABREVIARNOMES = Texto
Exit Function
End If

'Retornar todas a palavras do nome para uma matriz
Nomes = Split(Texto, " ")

'Retornar o primeiro nome
PrimeiroNome = Left(Texto, InStr(1, Texto, " ") - 1)

'Retornar o último nome
ÚltimoNome = Right(Texto, Len(Texto) - InStrRev(Texto, " ", -1))

'Se não for informado o argumento opcional, é atribuída uma cadeia vazia
If IsMissing(NomesSemAbreviar) Then
Opcional = 1
End If
'Loop para percorrer os nomes do texto informado
For Each Nome In Nomes
Select Case Len(Nome)
'Não abreviar conectores como "e"
Case 1
Abrev = Abrev & Nome & Space(1)
'Não abreviar conectores como "de" ou "das"
Case 2, 3
If Left(Nome, 1) = "d" Then Abrev = Abrev & Nome & Space(1)
Case Else
'Execução para o caso em que não há argumentos opcionais
If Opcional = 1 Then
Abrev = Abrev & UCase(Left(Nome, 1)) & "." & Space(1)
Else
'Quando há argumentos opcionais testa o nome contra cada um deles
For Each NomeSemAbreviar In NomesSemAbreviar
If Nome = NomeSemAbreviar Then
Controle = 1
Exit For
Else
Controle = 0
End If
Next NomeSemAbreviar

If Controle = 1 Then
'Se for encontrada coincidência com os argumentos opcionais, não realiza abreviatura
Abrev = Abrev & Nome & Space(1)
Else
'Se não for encontrada coincidência com os argumentos opcionais, realiza abreviatura
Abrev = Abrev & UCase(Left(Nome, 1)) & "." & Space(1)
End If
End If
End Select
Next Nome

'Criar o nome final definitivo, com abreviaturas e demais considerações
Abrev = PrimeiroNome & Right(Abrev, Len(Abrev) - InStr(1, Abrev, "."))
ABREVIARNOMES = Left(Abrev, Len(Abrev) - 3) & ÚltimoNome

End Function