Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Problème de code

Problème de code

11 réponses
Avatar
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
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" wrote:
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


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

"dunkelzahn" a écrit dans le message de
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" wrote:
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


Avatar
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" a écrit dans le message de news:

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

"dunkelzahn" a écrit dans le message de
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" wrote:
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






Avatar
lSteph
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" wrote:
Bonjour dunkelzahn
Merci de me répondre.
Je joins un fichier, ce seras plus explicite.http://cjoint.com/?lklncVtbi L
--
Cordialement
Guy

"dunkelzahn" a écrit dans le message denews: d4d6ebdd-967f-45fb-bce8-4de9371ce__BEGIN_MASK_n#9g02mG7!__...__END_ MASK_i?a63jfAD$
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" wrote:

> 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


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

"Youky" a écrit dans le message de news:

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" a écrit dans le message de news:

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

"dunkelzahn" a écrit dans le message de
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" wrote:
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










Avatar
Guy72
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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

"dunkelzahn" a écrit dans le message de
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" wrote:
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










Avatar
Youky
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
Avatar
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" a écrit dans le message de news:
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



Avatar
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" a écrit dans le message de news:
%
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" a écrit dans le message de news:
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







Avatar
Guy72
Re
Je te remercie de ton aide Youky
--
Cordialement
Guy

"Youky" a écrit dans le message de news:


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" a écrit dans le message de news:
%
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" a écrit dans le message de news:
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











1 2