Problème de code

Le
Guy72
Bonsoir,
Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
Une petite idée ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
For Each Cell In Sheets("Liste").Range("A:A")
If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
"Définition :"
Next
If flag Then Exit Sub
flag = True
If Target.Address = "$M$48" Then
Target.Value = UCase(Target.Value)
'Rows("42:37").ClearContents
y = 1
For X = 1 To Len([M48])
Cells(42, 37 + y) = Mid([M48], X, 1)
y = y + 2
Next
End If
flag = False
End Sub

Merci de votre aide

--
Cordialement
Guy
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
dunkelzahn
Le #17798171
Bonjour,

Quel est l'objectif de ce code et ou est le problème que tu perçois ?
flag est il déclaré autre part (pas dans ce code en tout cas) ?

On 9 nov, 18:55, "Guy72"
Bonsoir,
Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
Une petite idée ?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
   For Each Cell In Sheets("Liste").Range("A:A")
     If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
"Définition :"
   Next
If flag Then Exit Sub
flag = True
If Target.Address = "$M$48" Then
Target.Value = UCase(Target.Value)
'Rows("42:37").ClearContents
  y = 1
  For X = 1 To Len([M48])
  Cells(42, 37 + y) = Mid([M48], X, 1)
  y = y + 2
  Next
  End If
flag = False
End Sub

Merci de votre aide

--
Cordialement
Guy


Guy72
Le #17798391
Bonjour dunkelzahn
Merci de me répondre.
Je joins un fichier, ce seras plus explicite.
http://cjoint.com/?lklncVtbiL
--
Cordialement
Guy

"dunkelzahn" news:
Bonjour,

Quel est l'objectif de ce code et ou est le problème que tu perçois ?
flag est il déclaré autre part (pas dans ce code en tout cas) ?

On 9 nov, 18:55, "Guy72"
Bonsoir,
Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
Une petite idée ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
For Each Cell In Sheets("Liste").Range("A:A")
If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
"Définition :"
Next
If flag Then Exit Sub
flag = True
If Target.Address = "$M$48" Then
Target.Value = UCase(Target.Value)
'Rows("42:37").ClearContents
y = 1
For X = 1 To Len([M48])
Cells(42, 37 + y) = Mid([M48], X, 1)
y = y + 2
Next
End If
flag = False
End Sub

Merci de votre aide

--
Cordialement
Guy


Youky
Le #17798641
Voiçi, qui fonctionne,
Bonjour de Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
y = 1
For X = 1 To Len([F24])
Cells(6, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub


"Guy72"
Bonjour dunkelzahn
Merci de me répondre.
Je joins un fichier, ce seras plus explicite.
http://cjoint.com/?lklncVtbiL
--
Cordialement
Guy

"dunkelzahn" news:
Bonjour,

Quel est l'objectif de ce code et ou est le problème que tu perçois ?
flag est il déclaré autre part (pas dans ce code en tout cas) ?

On 9 nov, 18:55, "Guy72"
Bonsoir,
Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
Une petite idée ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
For Each Cell In Sheets("Liste").Range("A:A")
If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
"Définition :"
Next
If flag Then Exit Sub
flag = True
If Target.Address = "$M$48" Then
Target.Value = UCase(Target.Value)
'Rows("42:37").ClearContents
y = 1
For X = 1 To Len([M48])
Cells(42, 37 + y) = Mid([M48], X, 1)
y = y + 2
Next
End If
flag = False
End Sub

Merci de votre aide

--
Cordialement
Guy






lSteph
Le #17798631
Bonjour,

pas besoin suffirait de comparer directement avec ucase.

mais bon , va savoir à quoi ca sert c'est comme les lettres avec
espace en haut.

Voilà tout de même pour mettre en majuscule :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Set isect = Intersect(Target, [F24])
If isect Is Nothing Then Exit Sub
On Error GoTo fin
Application.EnableEvents = False
[F24] = UCase([F24])
fin:
Application.EnableEvents = True
End Sub


On 10 nov, 11:16, "Guy72"
Bonjour dunkelzahn
Merci de me répondre.
Je joins un fichier, ce seras plus explicite.http://cjoint.com/?lklncVtbi L
--
Cordialement
Guy

"dunkelzahn" Bonjour,

Quel est l'objectif de ce code et ou est le problème que tu perçois ?
flag est il déclaré autre part (pas dans ce code en tout cas) ?

On 9 nov, 18:55, "Guy72"
> Bonsoir,
> Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
> Une petite idée ?

> Private Sub Worksheet_Change(ByVal Target As Range)
> If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
> For Each Cell In Sheets("Liste").Range("A:A")
> If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
> "Définition :"
> Next
> If flag Then Exit Sub
> flag = True
> If Target.Address = "$M$48" Then
> Target.Value = UCase(Target.Value)
> 'Rows("42:37").ClearContents
> y = 1
> For X = 1 To Len([M48])
> Cells(42, 37 + y) = Mid([M48], X, 1)
> y = y + 2
> Next
> End If
> flag = False
> End Sub

> Merci de votre aide

> --
> Cordialement
> Guy


Guy72
Le #17798871
Bonjour Youky
C'est tout à fait ça qu'il me faut.
Merci
--
Cordialement
Guy

"Youky"
Voiçi, qui fonctionne,
Bonjour de Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
y = 1
For X = 1 To Len([F24])
Cells(6, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub


"Guy72"
Bonjour dunkelzahn
Merci de me répondre.
Je joins un fichier, ce seras plus explicite.
http://cjoint.com/?lklncVtbiL
--
Cordialement
Guy

"dunkelzahn" news:

Bonjour,

Quel est l'objectif de ce code et ou est le problème que tu perçois ?
flag est il déclaré autre part (pas dans ce code en tout cas) ?

On 9 nov, 18:55, "Guy72"
Bonsoir,
Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
Une petite idée ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
For Each Cell In Sheets("Liste").Range("A:A")
If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
"Définition :"
Next
If flag Then Exit Sub
flag = True
If Target.Address = "$M$48" Then
Target.Value = UCase(Target.Value)
'Rows("42:37").ClearContents
y = 1
For X = 1 To Len([M48])
Cells(42, 37 + y) = Mid([M48], X, 1)
y = y + 2
Next
End If
flag = False
End Sub

Merci de votre aide

--
Cordialement
Guy










Guy72
Le #17799671
Salut Youky
Peut-tu modifier ton code avec le code qui est en dessous et en faire qu'un
?
Je pense qu'il n'y a pas grand chose à modifier mais je ne sais pas comment
faire.

Fichier joint : http://cjoint.com/?lkogEhFwxu
--
Cordialement
Guy

"Youky"
Voiçi, qui fonctionne,
Bonjour de Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
y = 1
For X = 1 To Len([F24])
Cells(6, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub


"Guy72"
Bonjour dunkelzahn
Merci de me répondre.
Je joins un fichier, ce seras plus explicite.
http://cjoint.com/?lklncVtbiL
--
Cordialement
Guy

"dunkelzahn" news:

Bonjour,

Quel est l'objectif de ce code et ou est le problème que tu perçois ?
flag est il déclaré autre part (pas dans ce code en tout cas) ?

On 9 nov, 18:55, "Guy72"
Bonsoir,
Je doit avoir un mélange dans mon code, mais je ne vois pas quoi ?
Une petite idée ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Address <> "$M$48" Then Exit Sub
For Each Cell In Sheets("Liste").Range("A:A")
If Target.Value = Cell.Value Then MsgBox Cell.Offset(, 1), ,
"Définition :"
Next
If flag Then Exit Sub
flag = True
If Target.Address = "$M$48" Then
Target.Value = UCase(Target.Value)
'Rows("42:37").ClearContents
y = 1
For X = 1 To Len([M48])
Cells(42, 37 + y) = Mid([M48], X, 1)
y = y + 2
Next
End If
flag = False
End Sub

Merci de votre aide

--
Cordialement
Guy










Youky
Le #17800061
Hé ben revoilou.............
A+Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X, k
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
If [B2] <> "" Then MsgBox "C'est perdu": Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
For k = 16 To 1 Step -2
If Cells(k, 2) = "" Then Exit For
Next
y = 1
For X = 1 To Len([F24])
Cells(k, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub
Guy72
Le #17800251
Oui parfait, trop fort !!.
1)-Je souhaiterais avoir la fenêtre après (pas avant) que le mot soit écrit
dans lignes B16,B14......
2)-Peut-tu m'expliquer ce qu'il faut modifier, si je veux changer la
destination B16 et changer la destination du mot en R11.
--
Cordialement
Guy

"Youky" u$
Hé ben revoilou.............
A+Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X, k
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
If [B2] <> "" Then MsgBox "C'est perdu": Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
For k = 16 To 1 Step -2
If Cells(k, 2) = "" Then Exit For
Next
y = 1
For X = 1 To Len([F24])
Cells(k, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub



Youky
Le #17800721
Re,Re
Explications: pour B16-14-12...voir ligne verte ...k va donner le N° ligne à
écrire
Pour ce qui est du R11 je ne l'utilise pas dans la macro, celle-ci recherche
simplement si il est en feuille Liste.
Ce fichier me fait penser à bj-motus que j'ai créé et donné à Misange et
est dispo sur Excelabo
Si tu veux voir
Youky
http://www.excelabo.net/moteurs/compteclic.php?nom=bj-motus
Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X, k
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
If [B2] <> "" Then MsgBox "C'est perdu": Exit Sub
If flag Then Exit Sub
flag = True
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
If Target.Address = "$F$24" Then
For k = 16 To 1 Step -2
If Cells(k, 2) = "" Then Exit For
Next
'k est le N° ligne trouvé vide en partant de 16 et remontant de 2 en 2
jusqu'a 1
' y est la colonne
y = 1
For X = 1 To Len([F24])
Cells(k, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then
Range("B" & k & ":L" & k).Select
MsgBox "Définition: " & vbCr & .Cells(y, 2)
Exit For
End If
Next
End With
End Sub

"Guy72" %
Oui parfait, trop fort !!.
1)-Je souhaiterais avoir la fenêtre après (pas avant) que le mot soit
écrit dans lignes B16,B14......
2)-Peut-tu m'expliquer ce qu'il faut modifier, si je veux changer la
destination B16 et changer la destination du mot en R11.
--
Cordialement
Guy

"Youky" u$
Hé ben revoilou.............
A+Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X, k
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
If [B2] <> "" Then MsgBox "C'est perdu": Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
For k = 16 To 1 Step -2
If Cells(k, 2) = "" Then Exit For
Next
y = 1
For X = 1 To Len([F24])
Cells(k, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub







Guy72
Le #17800901
Re
Je te remercie de ton aide Youky
--
Cordialement
Guy

"Youky"

Re,Re
Explications: pour B16-14-12...voir ligne verte ...k va donner le N° ligne
à écrire
Pour ce qui est du R11 je ne l'utilise pas dans la macro, celle-ci
recherche simplement si il est en feuille Liste.
Ce fichier me fait penser à bj-motus que j'ai créé et donné à Misange et
est dispo sur Excelabo
Si tu veux voir
Youky
http://www.excelabo.net/moteurs/compteclic.php?nom=bj-motus
Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X, k
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
If [B2] <> "" Then MsgBox "C'est perdu": Exit Sub
If flag Then Exit Sub
flag = True
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
If Target.Address = "$F$24" Then
For k = 16 To 1 Step -2
If Cells(k, 2) = "" Then Exit For
Next
'k est le N° ligne trouvé vide en partant de 16 et remontant de 2 en 2
jusqu'a 1
' y est la colonne
y = 1
For X = 1 To Len([F24])
Cells(k, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then
Range("B" & k & ":L" & k).Select
MsgBox "Définition: " & vbCr & .Cells(y, 2)
Exit For
End If
Next
End With
End Sub

"Guy72" %
Oui parfait, trop fort !!.
1)-Je souhaiterais avoir la fenêtre après (pas avant) que le mot soit
écrit dans lignes B16,B14......
2)-Peut-tu m'expliquer ce qu'il faut modifier, si je veux changer la
destination B16 et changer la destination du mot en R11.
--
Cordialement
Guy

"Youky" u$
Hé ben revoilou.............
A+Youky

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, X, k
If Target.Count > 1 Or Target.Address <> "$F$24" Then Exit Sub
If [B2] <> "" Then MsgBox "C'est perdu": Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
With Sheets("Liste")
For y = 1 To .[A65000].End(3).Row
If Target.Value = .Cells(y, 1) Then _
MsgBox "Définition: " & vbCr & .Cells(y, 2): Exit For
Next
End With
If flag Then Exit Sub
flag = True
If Target.Address = "$F$24" Then
For k = 16 To 1 Step -2
If Cells(k, 2) = "" Then Exit For
Next
y = 1
For X = 1 To Len([F24])
Cells(k, 1 + y) = Mid([F24], X, 1)
y = y + 2
Next
End If
flag = False
End Sub











Publicité
Poster une réponse
Anonyme