Divisier une Textbox, sans couper les mots

Version imprimable

1 pièce(s) jointe(s)

Bonjour le forum,

Dans l'un de mes Userforms, je cherche à mettre en place de la mise en forme textuelle.
Dans ma Textbox1, une information est automatiquement importée.
Celle doit réapparaitre dans la Textbox 2 et 3 en tenant compte que :
* La textbox 2 ne doit pas faire plus de 35 caractères (Pas de limite sur la textbox 3).
* La troncature ne peut pas se faire au hasard, elle doit se faire au dernier espace avant les 35 caractères [Donc, on ne coupe pas un mot un 2]

J'ai déjà trouvé une partie du code, mais j'ai un soucis avec celui-ci : Il me fait disparaître tous les mots, compris entre le 35eme et le dernier caractère.
(Comme montré sur l'exemple ci dessous)

Pièce jointe 571272

Si vous avez une idée de ce qui pose un soucis, je suis preneuse.
Merci d'avance :) !

Code:

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
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Sub TextBox1_Change() 
 
Dim str_test As String
Dim Ch
Dim ADRESSEGLOBALE As String
Dim Mot As String
Dim Motcherche As String
 
'supprimer les virgules et retirer les doubles espaces
ADRESSEGLOBALE = func_DelAllSpace(Textbox1.Value)
 
'Troncature à 35
Mot = ADRESSEGLOBALE
Ch = Split(Mot, " ")
Motcherche = Ch(UBound(Ch))
 
TextBox2.Value = Libelle1(ADRESSEGLOBALE)
TextBox3.Value = Motcherche
 
End Sub
 
 Function Libelle1(strString As String) As String
    Dim lib As String
    Dim charact1 As String
    Dim charact2 As String
    Dim strString2 As String
    Dim intpositioncharact3 As Integer
 
    charact1 = Mid(strString, 34, 1)
    charact2 = Mid(strString, 35, 1)
    strString2 = Mid(strString, 1, 34)
    intpositioncharact3 = LastOccurence(strString2, " ")
 
    If charact1 = " " Then
    lib = Mid(strString, 1, 34)
    End If
    If charact2 = " " Then
    lib = Mid(strString, 1, 34)
    End If
    If charact1 <> " " Then
    lib = Mid(strString, 1, intpositioncharact3)
    End If
   Libelle1 = lib
 
End Function
 
  Function LastOccurence(strString As String, strCharacter As String) As Integer
    Dim intPosition As Integer
 
     intPosition = 1
 
     While intPosition <= Len(strString) And strCharacter <> "" And InStr(intPosition, strString, strCharacter) <> 0
     intPosition = InStr(intPosition, strString, strCharacter)
     LastOccurence = intPosition
     intPosition = intPosition + 1
     Wend
 
End Function

08/06/2020, 17h06
mfoxy

Bonjour,

Pour ta textbox2, tu pourrais sans doute effectué un replace de ta première chaîne de caractère trouvée par "" il ne resterai donc que le reste de la chaîne.

Bonjour,

Merci pour votre aide!
Je suis novice en VBA, et donc, je suis pas sûre d'avoir compris.
Vous pourriez détailler ?

----------------

EDIT :

Oh, je viens de comprendre, du coup ça fonctionne parfaitement merci :) !

Code:

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
'Troncature à 35
Mot = ADRESSEGLOBALE
 
Ch = Split(Mot, " ")
Motcherche = Replace(ADRESSEGLOBALE, Libelle1(ADRESSEGLOBALE), "")
 
 Function Libelle1(strString As String) As String
    Dim lib As String
    Dim charact1 As String
    Dim charact2 As String
    Dim strString2 As String
    Dim intpositioncharact3 As Integer
 
    charact1 = Mid(strString, 34, 1)
    charact2 = Mid(strString, 35, 1)
    strString2 = Mid(strString, 1, 34)
    intpositioncharact3 = LastOccurence(strString2, " ")
 
    If charact1 = " " Then
    lib = Mid(strString, 1, 34)
    End If
    If charact2 = " " Then
    lib = Mid(strString, 1, 34)
    End If
    If charact1 <> " " Then
    lib = Mid(strString, 1, intpositioncharact3)
    End If
   Libelle1 = lib
 
End Function