web-dev-qa-db-fra.com

Suppression de caractères spéciaux VBA Excel

J'utilise VBA pour lire des TITRES puis pour copier ces informations dans une présentation PowerPoint.

Mon problème est que les TITRES ont des caractères spéciaux, mais les fichiers d’image que je gère également ne le sont pas.

TITLE fait partie d’un chemin permettant de charger un fichier JPEG dans un conteneur d’images. Par exemple. "P k.jpg", mais le titre s'appelle "p.k".

Je veux pouvoir ignorer les caractères spéciaux dans le titre et lui faire voir un espace à la place pour qu'il récupère le bon fichier JPG.

Est-ce possible?

Je vous remercie!

excelvbaexcel-vbaexcel-2010
5
pixie

Qu'est-ce que vous considérez comme des caractères "spéciaux", une simple ponctuation? Vous devriez pouvoir utiliser la fonction Replace: Replace("p.k","."," "). 

Sub Test()
Dim myString as String
Dim newString as String

myString = "p.k"

newString = replace(myString, ".", " ")

MsgBox newString

End Sub

Si vous avez plusieurs caractères, vous pouvez le faire dans une fonction personnalisée ou une simple série chaînée de fonctions Replace, etc.

  Sub Test()
Dim myString as String
Dim newString as String

myString = "!p.k"

newString = Replace(Replace(myString, ".", " "), "!", " ")

'## OR, if it is easier for you to interpret, you can do two sequential statements:
'newString = replace(myString, ".", " ")
'newString = replace(newString, "!", " ")

MsgBox newString

End Sub

Si vous avez beaucoup de caractères spéciaux potentiels (ascii accent non anglais, par exemple?), Vous pouvez créer une fonction personnalisée ou une itération sur un tableau.

Const SpecialCharacters As String = "!,@,#,$,%,^,&,*,(,),{,[,],},?"  'modify as needed
Sub test()
Dim myString as String
Dim newString as String
Dim char as Variant
myString = "!p#*@)k{kdfhouef3829J"
newString = myString
For each char in Split(SpecialCharacters, ",")
    newString = Replace(newString, char, " ")
Next
End Sub
28
David Zemens

Si vous souhaitez non seulement exclure une liste de caractères spéciaux, mais également tous les caractères qui ne sont ni des lettres ni des chiffres, nous vous suggérons d'utiliser une méthode de comparaison des types de caractères.

Pour chaque caractère de la chaîne, je vérifierais si le caractère unicode est compris entre "A" et "Z", entre "a" et "z" ou entre "0" et "9". C'est le code vba:

Function cleanString(text As String) As String
    Dim output As String
    Dim c 'since char type does not exist in vba, we have to use variant type.
    For i = 1 To Len(text)
        c = Mid(text, i, 1) 'Select the character at the i position
        If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
            output = output & c 'add the character to your output.
        Else
            output = output & " " 'add the replacement character (space) to your output
        End If
    Next
    cleanString = output
End Function

Le liste Wikipedia des caractères Unicode } est un bon départ rapide si vous souhaitez personnaliser un peu plus cette fonction.

Cette solution présente l’avantage d’être fonctionnelle même si l’utilisateur trouve un moyen d’introduire de nouveaux caractères spéciaux. C'est aussi plus rapide que de comparer deux listes ensemble.

7
V. Brunelle

Voici comment les caractères spéciaux ont été supprimés.

J'ai simplement appliqué regex

Dim strPattern As String: strPattern = "[^a-zA-Z0-9]" 'The regex pattern to find special characters
Dim strReplace As String: strReplace = "" 'The replacement for the special characters
Set regEx = CreateObject("vbscript.regexp") 'Initialize the regex object    
Dim GCID As String: GCID = "Text #N/A" 'The text to be stripped of special characters

' Configure the regex object
With regEx
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = strPattern
End With

' Perform the regex replacement
GCID = regEx.Replace(GCID, strReplace)
4
GuruKay

C’est ce que j’utilise, basé sur ce link

Function StripAccentb(RA As Range)

Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Dim S As String
'Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
'Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
Const AccChars = "ñéúãíçóêôöá" ' using less characters is faster
Const RegChars = "neuaicoeooa"
S = RA.Cells.Text
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
S = Replace(S, A, B)
'Debug.Print (S)
Next


StripAccentb = S

Exit Function
End Function

Usage:

=StripAccentb(B2) ' cell address

Sous-version pour toutes les cellules d'une feuille:

Sub replacesub()
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Dim S As String
Const AccChars = "ñéúãíçóêôöá" ' using less characters is faster
Const RegChars = "neuaicoeooa"
Range("A1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select '
For Each cell In Selection
If cell <> "" Then
S = cell.Text
    For i = 1 To Len(AccChars)
    A = Mid(AccChars, i, 1)
    B = Mid(RegChars, i, 1)
    S = replace(S, A, B)
    Next
cell.Value = S
Debug.Print "celltext "; (cell.Text)
End If
Next cell
End Sub
2
Ferroao