Modifier partie de mon code pour sélectionner mot abregé

Z

zombe

XLDnaute Occasionnel
Salut le forum

Dans le lien ci-dessous, j'ai sollicité un code me permettant de bloquer les saisie dans des cellules avec des mots abregés. ce qui a été bien réalisé.
J'ai l'impression que cette partie du code efface le mot saisi dans la cellule ou y'a l'abreviation et d'activer la dite cellule.
Au lieu que le mot soit effacé, je souhaite que la lettre ou l'élément abregé soit sélectionné afin que la correction y soit apportée.
Merci de me donner un coup de main.
Code: 
Target = ""
Target.Activate

Alerte de saisie de mot abregé : Excel - VBA
 
Trier par date Trier par votes
JCGL

JCGL

XLDnaute Barbatruc
Re : Modifier partie de mon code pour sélectionner mot abregé

Bonjour à tous,

Peux-tu essayer avec :

VB: 
For i = 0 To UBound(Tableau)
            If Len(Tableau(i)) = 1 Or Right(Tableau(i), 1) = "." Then
                MsgBox ("La saisie d'une lettre seule ou d'un point est interdite")
                'Target = ""
                Target.Activate
                Application.EnableEvents = True
                Exit Sub
            End If
        Next i

A + à tous
 
Vote positif 0 Vote négatif
Z

zombe

XLDnaute Occasionnel
Re : Modifier partie de mon code pour sélectionner mot abregé

Salut JCGL

Merci pour votre solution.
Je constate que la valeur de la cellule lorsque y'a abreviation est conservée.
J'apprécie si ce que j'ai demandé n'est pas possible.
Ce que j'ai demandé est que la valeur de la cellule soit conservée et que le curseur se positionne la ou y'a l'abreviation.
Merci
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : Modifier partie de mon code pour sélectionner mot abregé

Bonjour Zombe, salut mon JC ;)

Une possibilité est de demander la nouvelle valeur dans un Inputbox()
Voici le code
VB: 
    For i = 0 To UBound(Tableau)
      Do While Len(Tableau(i)) = 1 Or Right(Tableau(i), 1) = "."
        MsgBox ("La saisie d'une lettre seule ou d'un point est interdite")
        NewTxt = InputBox("Merci de saisir la valeur de remplacment pour [" & Tableau(i) & "]", "NOUVELLE VALEUR ...")
        If NewTxt <> "" Then
          For NbMot = 0 To i
            Pos = Pos + Len(Tableau(NbMot)) + 1
          Next NbMot
          Pos = Pos - 2
          ' Remplacer la partie qui ne va pas
          Application.EnableEvents = False
          Target.Value = Left(Groupe_mots, Pos) & NewTxt & Mid(Groupe_mots, Pos + 2)
          Application.EnableEvents = True
        End If
        Pos = 0 ' Remettre à zéro la position
        ' Redéfinir le tableau
        Tableau = Split(Target.Value, " ")
      Loop
    Next i

A+
 
Vote positif 0 Vote négatif
Z

zombe

XLDnaute Occasionnel
Re : Modifier partie de mon code pour sélectionner mot abregé

Salut BrunoM45

Merci pour votre intervention.
L'idée est géniale.
Je rencontre un débogage lors du test ici :
Code: 
Pos = Pos + Len(Tableau(NbMot)) + 1
Aussi je trouve que y'a des variables que vous avez laissée pour que je déclare.
Je ne sais pas si j'ai reussi mais voir le code intégrale pour appréciation:
Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

If Target.Count > 1 Then Exit Sub

    If Not Application.Intersect(Target, Range("B13:B16")) Is Nothing Then
    Dim Tableau() As String, i As Integer, Pos As Integer, Groupe_mots As String, NewTxt As String, NbMot As Integer
    
    Groupe_mots = Target
    Tableau = Split(Groupe_mots, " ")
    
    Application.EnableEvents = False
    For i = 0 To UBound(Tableau)
       Do While Len(Tableau(i)) = 1 Or Right(Tableau(i), 1) = "."
         MsgBox ("La saisie d'une lettre seule ou d'un point est interdite")
         NewTxt = InputBox("Merci de saisir la valeur de remplacment pour [" & Tableau(i) & "]", "NOUVELLE VALEUR ...")
         If NewTxt <> "" Then
           For NbMot = 0 To i
             Pos = Pos + Len(Tableau(NbMot)) + 1
           Next NbMot
           Pos = Pos - 2
           ' Remplacer la partie qui ne va pas
          Application.EnableEvents = False
           Target.Value = Left(Groupe_mots, Pos) & NewTxt & Mid(Groupe_mots, Pos + 2)
           Application.EnableEvents = True
         End If
         Pos = 0 ' Remettre à zéro la position
        ' Redéfinir le tableau
        Tableau = Split(Target.Value, " ")
       Loop
     Next i
    End If

Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : Modifier partie de mon code pour sélectionner mot abregé

Bonjour à tous,

Ceci fonctionne chez moi et sous XL 2010 :

VB: 
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ValSaisie
    Dim P As Integer
    Dim NewTxt As String
    Dim NbMot%, Pos%


    Application.ScreenUpdating = False


    If Target.Count > 1 Then Exit Sub


    If Not Application.Intersect(Target, Range("B13:B16")) Is Nothing Then
        Dim Tableau() As String, i As Integer, Groupe_mots As String


        Groupe_mots = Target
        Tableau = Split(Groupe_mots, " ")


        Application.EnableEvents = False
        For i = 0 To UBound(Tableau)
            Do While Len(Tableau(i)) = 1 Or Right(Tableau(i), 1) = "."
                MsgBox ("La saisie d'une lettre seule ou d'un point est interdite")
                NewTxt = InputBox("Merci de saisir la valeur de remplacment pour [" & Tableau(i) & "]", "NOUVELLE VALEUR ...")
                If NewTxt <> "" Then
                    For NbMot = 0 To i
                        Pos = Pos + Len(Tableau(NbMot)) + 1
                    Next NbMot
                    Pos = Pos - 2
                    ' Remplacer la partie qui ne va pas
                    Application.EnableEvents = False
                    Target.Value = Left(Groupe_mots, Pos) & NewTxt & Mid(Groupe_mots, Pos + 2)
                    Application.EnableEvents = True
                End If
                Pos = 0    ' Remettre à zéro la position
                ' Redéfinir le tableau
                Tableau = Split(Target.Value, " ")
            Loop
        Next i
    End If


    On Error GoTo Fin
Fin:
    If Not Intersect(Range("B6,B11,B30,B10,B33,B34"), Target) Is Nothing Then
        Application.EnableEvents = False
        ValSaisie = Target
        Application.Undo
        P = InStr(Target, ValSaisie)
        If P > 0 Then
            Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
            If Right(Target, 1) = "+" Then
                Target = Left(Target, Len(Target) - 1)
            End If
        Else
            If Target = "" Then
                Target = ValSaisie
            Else
                Target = Target & "+" & ValSaisie
            End If
        End If
        Application.EnableEvents = True
    End If
    Application.EnableEvents = True    ' Dans tous les cas on remet les évènements en service
End Sub

A + à tous
 
Vote positif 0 Vote négatif
Z

zombe

XLDnaute Occasionnel
Re : Modifier partie de mon code pour sélectionner mot abregé

Salut JCGL

Super. Je vois que je n'avais pas reussi les déclarations.
En remplacant vos déclarations par les miennes, je vois que tout fonctionne.
Merci à vous tous
 
Vote positif 0 Vote négatif
B

bear the french

XLDnaute Nouveau
Re : Modifier partie de mon code pour sélectionner mot abregé

Bonjour,

Une solution sans InputBox et pour positionner directement le curseur dans la cellule, à l'emplacement du problème (soit après la lettre isolée, soit à la place du point) :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie
Dim P, j As Integer
Dim nouvelleposition As String


Application.ScreenUpdating = False

If Target.Count > 1 Then Exit Sub

    If Not Application.Intersect(Target, Range("B13:B16")) Is Nothing Then
    Dim Tableau() As String, i As Integer, Groupe_mots As String
    
    Groupe_mots = Target
    Tableau = Split(Groupe_mots, " ")
    
    Application.EnableEvents = False
    For i = 0 To UBound(Tableau)
        'vérifie la présence d'une erreur = 1 seul caractère ou une fin avec un point
        If Len(Tableau(i)) = 1 Then
            'Affiche un message d'erreur
            MsgBox ("La saisie d'une lettre seule est interdite")
 
            'vide la cellule cible de la totalité de la saisie
            Target = ""
 
            'la cellule cible va prendre progressivement le texte tant que valable
            For j = 0 To i
                'une forme particulière s'il y a qu'un terme correct dans le tableau
                If j = 0 Then
                    nouvelleposition = Tableau(j)
                'sinon association des termes corrects en chaine de caractères
                Else
                    nouvelleposition = nouvelleposition & " " & Tableau(j)
                End If
            Next j
            'revenir dans la cellule ciblée par l'erreur
            Target.Activate
            'positionne le curseur après le texte incorrect
            Application.SendKeys Groupe_mots & "{F2}{LEFT " & Len(Groupe_mots) - Len(nouvelleposition) & "}"
            Application.EnableEvents = True
            Exit Sub
        End If
 
        'vérifie la présence d'une erreur = une fin avec un point
        If Right(Tableau(i), 1) = "." Then
            'Affiche un message d'erreur
            MsgBox ("La saisie d'un point en fin de mot est interdite")
            'vide la cellule cible de la totalité de la saisie
            Target = ""
            'la cellule cible va prendre progressivement le texte tant que valable
            For j = 0 To i
                'une forme particulière s'il y a qu'un terme correct dans le tableau
                If j = 0 Then
                    nouvelleposition = Tableau(j)
                'sinon association des termes corrects en chaine de caractères
                Else
                    nouvelleposition = nouvelleposition & " " & Tableau(j)
                End If
            Next j
            'revenir dans la cellule ciblée par l'erreur
            Target.Activate
            'positionne le curseur après le texte incorrect (avant l'ancien point)
            Groupe_mots = Replace(Groupe_mots, ".", "")
            Application.SendKeys Groupe_mots & "{F2}{LEFT " & Len(Groupe_mots) - Len(nouvelleposition) + 1 & "}"
            Application.EnableEvents = True
            Exit Sub
        End If
    Next i
    End If

    On Error GoTo Fin
Fin:
    If Not Intersect(Range("B6,B11,B30,B10,B33,B34"), Target) Is Nothing Then
        Application.EnableEvents = False
        ValSaisie = Target
        Application.Undo
        P = InStr(Target, ValSaisie)
        If P > 0 Then
            Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
            If Right(Target, 1) = "+" Then
                Target = Left(Target, Len(Target) - 1)
            End If
        Else
            If Target = "" Then
                Target = ValSaisie
            Else
                Target = Target & "+" & ValSaisie
            End If
        End If
        Application.EnableEvents = True
    End If
 Application.EnableEvents = True   ' Dans tous les cas on remet les évènements en service
End Sub

Bertrand
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
XL 2016 Recherche de partie de mot dans les cellules d'un tableau et extractions des résultats
2
Réponses
29
Affichages
1 K
Lorenzini
L
A
  • Résolu(e)
XL 2010 Renvoyer le N° de ligne d'une partie numérique identique à un code
2 3
Réponses
34
Affichages
1 K
Dranreb
Dranreb
A
  • Question
ajouter une partie de code dans mon userform
Réponses
13
Affichages
2 K
AKRAMI
A
M
  • Question
XL 2013 Traitement trop long optimisation de code pour générer 2 états
3 4 5
Réponses
70
Affichages
5 K
Dranreb
Dranreb
S
  • Question
Après activation de son mot de passe dans une feuille on accède à son espace perso su
Réponses
8
Affichages
2 K
BOISGONTIER
BOISGONTIER
M
  • Question
XL 2013 Optimisation de code pour une présentation
Réponses
5
Affichages
1 K
Merlin258413
M
jayroom
  • Question
macro pour modifier une cellule déverouillée par mot de passe
Réponses
7
Affichages
2 K
jayroom
jayroom
A
  • Question
VBA PB avec une partie de mon code
Réponses
2
Affichages
829
Arpette
A
S
  • Question
Modifier un code existant pour recherche sous condition
Réponses
14
Affichages
1 K
SSIAP2
S
G
  • Question
Recherche conseils avises pour finaliser la realisation d'un tableau de bord
3 4 5
Réponses
70
Affichages
81 K
Bebere
B

Membres actuellement en ligne

3 membres et 42 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin