Ao processar um arquivo XML a partir da web tive alguns caracteres especiais, parecidos aos mostrados abaixo, mas o analisador MSXML recusou-se a aceitá-los. Precisaram ser convertidos ao normal (ou seja, sem sotaque) antes que possam ser analisados pelo XML.
Referio-me aos caracteres acentuados que se parecem com isto: é, ñ, André.
Aqui está uma ligeira adaptação do código. Basta passar como parâmetro qualquer seqüência que desejar expurgar; quaisquer caracteres estranhos serão substituídos por seus equivalentes não-acentuados. Poderá usar este código como uma Função VBA numa planilha, bem como em outros aplicativos da suíte MS Office.
Este código tem algumas pequenas variações, por exemplo, em vez de sempre efetuar um loop através da lista de caracteres acentuados, ele percorre a cadeia de entrada que for mais curta.
Function ConvertAccent (ByVal inputString As String) As String
Const AccChars As String = _
"ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars As String = _
"SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long
Let 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
Let currentCharacter = Mid$(AccChars, i, 1)
' replace with corresponding character in "regular" array
If InStr(tempString, currentCharacter) > 0 Then
Let 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
Let currentCharacter = Mid$(inputString, i, 1)
Let found = (InStr(AccChars, currentCharacter) > 0)
If found Then
' find position of special character in special array
Let foundPosition = InStr(AccChars, currentCharacter)
' replace with corresponding character in "regular" array
Let tempString = Replace(tempString, currentCharacter, _
Mid$(RegChars, foundPosition, 1))
End If
Next i
End Select
Let ConvertAccent = tempString
End Function
Se a lista de caracteres acentuados for mais curta (o cenário mais provável), então dê um nó laço com ele e dê a cada carácter a uma variável String. Se existir na cadeia de entrada, o caractere acentuado será substituído com o carácter na lista de seqüência regular, mesmo se ele for encontrado várias vezes (a função Replace). Portanto, independentemente do tamanho da cadeia de entrada, o circuito só será executada 60 vezes (o número de caracteres acentuados) por String.
Se a lista de caracteres acentuados for maior, então ocorrerá um loop através da cadeia de entrada. Cada carácter será pego e atribuído a uma variável String. Se for encontrado na lista de caracteres acentuados, será substituído com o caractere correspondente na lista de cadeia normal. Mesmo que a lista de caracteres acentuados contenha 60 caracteres, o loop só irá executar n vezes (o número de caracteres na cadeia de entrada).
Segue um código variante:
Function ConvertAccent2 (ByVal inputString As String) As String
Dim X As Long, Position As Long
Const AccChars As String = _
"ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars As String = _
"SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For X = 1 To Len(inputString)
Let Position = InStr(AccChars, Mid(inputString, X, 1))
If Position Then Mid(inputString, X) = Mid(RegChars, Position, 1)
Next
Let ConvertAccent = inputString
End Function
Tags: VBA, XML, Tips, rename, caracter, character, acentuado, MSXML
