Views

Histats

Vitrine

VBA Tips - Retirando acento - Remove and replace accent characters from a string.

Inline image 1

Sei que você já tem uma função que retira acento, aliás, eu mesmo já postei uma solução destas por aqui. Mas sempre é bom olharmos para mais de uma solução:

Function ConvertAccent(ByVal inputString As String) As String
 
Const AccChars As String = _
      "²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ'"
Const RegChars As String = _
      "2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"
 
Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long
 
  tempString = inputString
 
  ' loop through the shorter string
 Select Case True
    Case Len(AccChars) <= Len(inputString)
      ' accent character list is shorter (or same)
     ' loop through accent character string
     For i = 1 To Len(AccChars)
 
        ' get next accent character
       currentCharacter = Mid$(AccChars, i, 1)
 
        ' replace with corresponding character in "regular" array
       If InStr(tempString, currentCharacter) > 0 Then
          tempString = Replace(tempString, currentCharacter, _
                               Mid$(RegChars, i, 1))
        End If
      Next i
    Case Len(AccChars) > Len(inputString)
      ' input string is shorter
     ' loop through input string
     For i = 1 To Len(inputString)
 
        ' grab current character from input string and
       ' determine if it is a special char
       currentCharacter = Mid$(inputString, i, 1)
        found = (InStr(AccChars, currentCharacter) > 0)
 
        If found Then
 
          ' find position of special character in special array
         foundPosition = InStr(AccChars, currentCharacter)
 
          ' replace with corresponding character in "regular" array
         tempString = Replace(tempString, currentCharacter, _
                               Mid$(RegChars, foundPosition, 1))
 
        End If
      Next i
  End Select
 
  ConvertAccent = tempString
End Function

Referências
Tags: VBA, Outlook, email, anexar, 


Inline image 2

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...