Discussion :

[Marino69]

Bonjour,

J'essaie d'utiliser la fonction Trim pour supprimer les espaces situés de part et d'autres d'une chaine de caractère

Le code ci-dessous permet de capturer le titre d'un document dans une variable (TitreFH), pour qu'il soit repositionné ultérieurement au niveau d'un signet.
Ce code doit aussi supprimer des caractères non désirés comme ".", ":", "retour à la ligne" : pour ces objectifs le code fonctionne.

En revanche, je n'arrive pas à utiliser Trim pour supprimer les espaces inutiles situés de part et d'autre du titre.
Pourriez-vous m'aider ?

Cordialement
Marino

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub RecupererIdentifiantsDocEnCours(ByVal DocEnCours3 As Document)
 
'Cette sub doit capturer le titre du document dans une variable, qui sera utilisée ultérieurement dans une autre sub
'Elle doit aussi "nettoyer" la chaine de caractères de ce titre    
 
Public TitreFH As String   '--> déclaré dans le Module des variables publiques       
 
       TitreFH = DocEnCours3.Sections(1).Headers(1).Range.Tables(2).Cell(1, 1).Range.Text
 
       'Pour nettoyer le titre :
       TitreFH = Replace(TitreFH, vbCr, "")               'Pour supprimer le retour Chariot s'il y en a
       TitreFH = Replace(TitreFH, ":", vbNullString)   'pour supprimer les 2points s'il y en a
       TitreFH = Replace(TitreFH, ".", vbNullString)   'pour supprimer les points s'il y en a
 
       'Pour supprimer les espaces inutiles, à gauche et à droite de la chaine  
       TitreFH = Trim(TitreFH)    '--> ne fonctionne pas
 
 
End Sub

[Invité]

Ta variable public doit être en tête de ton module.

Comme indiqué hier, utilise la fonction Mid et retranche 1 caractère. Sinon, mets un exemple en ligne.

[Marino69]

Bonjour Eric,

Voilà en pièce jointe le fichier avec les macros de "nettoyage" de titre :

Les différents fichiers que la macro doit traiter ne sont pas tous équivalents :
- Il y a souvent (mais pas toujours) des espaces en fin ou en début de titre, et jamais le même nombre
- La présence et le nombre de points diffèrent aussi d'un fichier à traiter à l'autre

J'ai en fait 2 problèmes :

- SupprimerLesEspaces:
attendu : espaces a gauche et à droite du titre supprimés
résultat : seuls les espaces situés à gauche sont supprimés

- SupprimerLesPoints : pour mieux visualiser, j'ai codé remplacer les points par x
attendu : tous les points supprimés (remplacés par x), y compris ceux situés à l'intérieur de la chaine
résultat : seuls quelques points sont remplacés par x
J'ai remarqué que lorsque je parcours les points avec la flèche droite ou gauche du clavier, le pointeur de souris saute d'un "paquets de 3 points" au suivant, puis se déplace de point en point pour ceux qui restent (< 3 points) - Seuls les points hors des "paquets de 3" sont remplacés par x.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Sub SupprimerLesPoints()
 
'Objectif : supprimer les points,
 
Dim DocEnCours As Document
Dim TitreFH As String
 
Set DocEnCours = ActiveDocument
 
       TitreFH = DocEnCours.Sections(1).Headers(1).Range.Tables(2).Cell(1, 1).Range.Text
       MsgBox Len(TitreFH)
 
       'pour supprimer les points :
       TitreFH = Replace(TitreFH, ".", "x")            '--> "x" à la place de "" pour visualiser que ce code ne remplace
                                                       'que les points "hors d'un groupe de 3 points"
       'TitreFH = Replace(TitreFH, ".", vbNullString)  '--> ne fonctionne que pour les points "hors d'un groupe de 3 points"
       'TitreFH = Replace(TitreFH, "...", vbNullString)  '--> ne supprime pas les groupes de 3 points
 
       DocEnCours.Bookmarks("TitreFH").Range.Text = TitreFH
       MsgBox Len(TitreFH)
 
 
End Sub
 
Sub SupprimerLesEspaces()
'Objectif : supprimer les espaces situés avant et à la fin du Titre
'Resultat : cette procédure ne supprime que les points situé avant le titre
 
Dim DocEnCours As Document
Dim TitreFH As String
 
 
Set DocEnCours = ActiveDocument
 
       TitreFH = DocEnCours.Sections(1).Headers(1).Range.Tables(2).Cell(1, 1).Range.Text
       MsgBox Len(TitreFH)
 
       TitreFH = Trim(TitreFH) 'ne supprime que les espaces avant le titre
       'TitreFH = Replace(TitreFH, " ", vbNullString)  '--> cette fonction supprime avant-Après et aussi les espaces dans la chaine de caractères
 
       DocEnCours.Bookmarks("TitreFH").Range.Text = TitreFH
       MsgBox Len(TitreFH)
 
End Sub

Cordialement,
Marino

[Invité]

Bonjour,

Regarde ce code qui teste la composition de ta chaîne. Il te permet d'identifier les caractères utilisés. La fonction Mid et un Select Case te permet d'écarter les caractères qui ne t'intéressent pas. Si tu as plusieurs mots dans ta chaîne, il te faudra décompter les Chr(32) et Chr(160) pour au moins en laisser 1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
Sub TesterLaCompositionDeLaChaine()
 
Dim DocEnCours As Document
Dim MonRange As Range
Dim MonTexte As String
Dim I As Integer, J As Integer
 
 
       MonTexte = ""
       Set DocEnCours = ActiveDocument
 
       With DocEnCours.Sections(1).Headers(1)
            If .IsHeader = True Then
                If .Range.Tables.Count > 1 Then
                   Set MonRange = .Range.Tables(2).Cell(1, 1).Range
                   With MonRange
                        For I = 1 To .Characters.Count
                            For J = 0 To 255
                                If Mid(.Text, I, 1) = Chr(J) Then
                                    Debug.Print "Position du caractère : " & I & ", caractère : " & Mid(.Text, I, 1) & ", code chr : " & J
                                    Select Case J
                                           Case 32, 160, 133, 46, 13
 
                                           Case Else
                                                MonTexte = MonTexte & Mid(.Text, I, 1)
                                    End Select
                                    Exit For
                                End If
                            Next J
                        Next I
                   End With
                End If
            End If
 
 
       End With
 
       Debug.Print MonTexte
 
 
End Sub