IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Divisier une Textbox, sans couper les mots [XL-2016]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Femme Profil pro
    Étudiant
    Inscrit en
    Octobre 2019
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Octobre 2019
    Messages : 27
    Par défaut Divisier une Textbox, sans couper les mots
    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)

    Nom : cAPTURE vba.png
Affichages : 301
Taille : 4,4 Ko

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

    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
    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

  2. #2
    Membre Expert Avatar de mfoxy
    Homme Profil pro
    Automation VBA
    Inscrit en
    Février 2018
    Messages
    752
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : Belgique

    Informations professionnelles :
    Activité : Automation VBA
    Secteur : High Tech - Opérateur de télécommunications

    Informations forums :
    Inscription : Février 2018
    Messages : 752
    Par défaut
    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.

  3. #3
    Membre averti
    Femme Profil pro
    Étudiant
    Inscrit en
    Octobre 2019
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Octobre 2019
    Messages : 27
    Par défaut
    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 : 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
    '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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 12
    Dernier message: 09/12/2008, 08h43
  2. Couper une chaine mais pas les mots
    Par Mygush dans le forum C#
    Réponses: 3
    Dernier message: 08/10/2008, 12h16
  3. Découper une chaine sans couper les mots
    Par jgoguel dans le forum Langage
    Réponses: 3
    Dernier message: 31/10/2007, 11h22
  4. Exécution d'une requête sans stocker les transactions
    Par Actarus69 dans le forum MS SQL Server
    Réponses: 6
    Dernier message: 24/03/2006, 12h45
  5. [EXCEL] copier une feuille sans changer les liaisons
    Par DidRocks dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 09/09/2005, 13h29

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo