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