Problème avec ; Private Sub Worksheet_Change

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais votre aide pour ce petit soucis .
Comment placer deux commande "Private Sub Worksheet_Change" dans une seule ? :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
If Application.Intersect(Range("D14😀27"), Target) Is Nothing Then Exit Sub
Dim maxLen As Integer, tabStr, i As Integer, tempStr
maxLen = 85

tabStr = Split(Target.Value, " ")
tempStr = ""
For i = LBound(tabStr) To UBound(tabStr)
If Len(tempStr & " " & tabStr(i)) < maxLen Then
If tabStr(i) <> "" Then tempStr = tempStr & " " & tabStr(i)
Else
If tempStr = "" Then tempStr = tabStr(i)
tempStr = Right(tempStr, Len(tempStr) - 1)
Target.Offset(1, 0).Value = Mid(Target.Value, Len(tempStr) + 2, Len(Target.Value) - Len(tempStr)) & " " & Target.Offset(1, 0).Value
Target.Value = tempStr
i = UBound(tabStr) + 1


End If
Next i
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A2:A200], Target) Is Nothing Then
If Len(Target) = 1 Then SendKeys "%{DOWN}"
End If
End Sub

Merci pour votre aide,
à+
Christian

 

[Staple1600]

Re : Problème avec ; Private Sub Worksheet_Change

Bonjour


Il doit y avoir qu'une seule

Private Sub Worksheet_Change(ByVal Target As Range)

dans le code d'une feuille.

C'est obligatoire.

edition: bonjour tototiti2008

 

[tototiti2008]

Re : Problème avec ; Private Sub Worksheet_Change

Bonjour Christian,

un essai

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
If Not Intersect([A2:A200], Target) Is Nothing Then
If Len(Target) = 1 Then SendKeys "%{DOWN}"
End If
If Application.Intersect(Range("D14:D27"), Target) Is Nothing Then Exit Sub
Dim maxLen As Integer, tabStr, i As Integer, tempStr
maxLen = 85
 
tabStr = Split(Target.Value, " ")
tempStr = ""
For i = LBound(tabStr) To UBound(tabStr)
If Len(tempStr & " " & tabStr(i)) < maxLen Then
If tabStr(i) <> "" Then tempStr = tempStr & " " & tabStr(i)
Else
If tempStr = "" Then tempStr = tabStr(i)
tempStr = Right(tempStr, Len(tempStr) - 1)
Target.Offset(1, 0).Value = Mid(Target.Value, Len(tempStr) + 2, Len(Target.Value) - Len(tempStr)) & " " & Target.Offset(1, 0).Value
Target.Value = tempStr
i = UBound(tabStr) + 1
End If
Next i
End Sub

Edit : Bonjour Staple 🙂

 

[Christian0258]

Re : Problème avec ; Private Sub Worksheet_Change

Re, le forum,

Merci à vous, tototiti2008 et Staple1600, pour vos solutions et leçons retenues.

Bien amicalement,
Christian

 

[Zebrino]

Bonjour à vous.

J'ai un problème proche de celui de "Christian0258"

J'ai deux commande "Private Sub Worksheet_Change" à placer dans une seule.
Après avoir retourné le problème dans tous les sens je suis dans une impasse.

Voici mes 2 commandes :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row > 1 Then
Target.Offset(0, 1) = Date + Time
End If
End Sub

Private Sub Worksheet_Change(ByVal sel As Range)
Application.EnableEvents = False
Cells(sel.Row, "M").Value = Date + Time
Application.EnableEvents = True
End Sub


Quelqu'un pourrait-il me donner un coup de main svp ?

Bruno

 

[Grand Chaman Excel]

Re : Problème avec ; Private Sub Worksheet_Change

Bonsoir,

Peut-être ainsi, en combinant les 2 ensemble...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row > 1 Then
    Target.Offset(0, 1) = Date + Time
End If

Range("M" & Target.Row).Value = Date + Time

End Sub