Petite question VBA : fonction worksheet_change

Bonjour,

Je ne maitrise pas beaucoup le VBA et j'ai ce fichier ci-joint,

Dans la cellule B2, j'ai une liste qui s'affiche suivant les premières lettres que je tape (ex :al, liste albert). Si le prénom n'existe pas dans la liste, j'ai une fonction worksheet-change qui me propose de l'ajouter à ma liste de prénom sur la feuille2. Pas de pb.

Par contre sur la cellule B3, la liste fonctionne aussi mais pas la fonction worksheet. Ainsi je ne peux ajouter le prénom tapé dans cette cellule s'il n'existe pas dans ma liste de référence.

j'ai essayé de recopier le language dans l'éditeur en mettant ceci mais ca ne fonctionne pas :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$2" And Target <> "" Then If IsError(Application.Match(Target.Value, [noms], 0)) Then If MsgBox("On ajoute?", vbYesNo) = vbYes Then [noms].End(xlDown).Offset(1, 0) = Target.Value Sheets("Feuil2").[noms].Sort key1:=Sheets("Feuil2").Range("A2") Else Application.Undo End If End If End If End Sub

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$3" And Target <> "" Then If IsError(Application.Match(Target.Value, [noms], 0)) Then If MsgBox("On ajoute?", vbYesNo) = vbYes Then [noms].End(xlDown).Offset(1, 0) = Target.Value Sheets("Feuil2").[noms].Sort key1:=Sheets("Feuil2").Range("A2") Else Application.Undo End If End If End If End Sub

---

Si quelqu'un pouvait m'aider ce serait super.

D'ailleurs si vous connaissez un bon site pour apprendre le VBA je suis preneur.

Merci beaucoup d'avance

Bonjour Airone784,
bienvenue sur DVP
en plus du présent forum, de nombreuses ressources sont à ta disposition :
- une http://excel.developpez.com/faq
- des tutoriaux http://exceldeveloppez.com/cours
- des critiques de livres http://excel.developpez.com/livres

Ici, je te recommande un peu de lectures,
toutes disponibles sur http://office.developpez.com/cours/

Si certains éléments te paraissent encore complexes, n'hésite pas à nous poser des questions.

Bon courage

Je ne suis pas une spécialiste, mais il me semblait avoir compris qu'on ne peut mettre qu'une fois chaque type de modification ( Worksheet_Change )

On peut par exemple tester si le target fait partie de la plage B2:B9 (au lieu de tester si c'est la cellule B2) (et pour tester ca, on fait l'intercection entre la page sectionnée et la plage jaune, si elle dedans, il y a quelque chose dans l'intercection, sinon c'est vide)

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Private Sub Worksheet_Change(ByVal Target As Range) Set Intersection = Application.Intersect(Target, Range("$B$2:$B$9")) If Not (Intersection Is Nothing) And Target <> "" Then If IsError(Application.Match(Target.Value, [noms], 0)) Then If MsgBox("On ajoute?", vbYesNo) = vbYes Then [noms].End(xlDown).Offset(1, 0) = Target.Value Sheets("Feuil2").[noms].Sort key1:=Sheets("Feuil2").Range("A2") Else Application.Undo End If End If End If End Sub

---

Emmanuelle, tu avais très bien compris... :ccool:

Il ne peut y avoir qu'une procédure événementielle par événement...

C'est à l'intérieur de la procédure que l'on testera les différents cas, soit comme tu le proposes avec Intersect, mais aussi en utilisant toutes les finesses de VB (If...End If, Select Case...End Select, Do...Loop, ...)

Merci Emmanuelle,

seul petit hic me concernant c'est que dans l'exemple la plage target est bien B2:B9 mais dans une autre feuille ou j'ai besoin d'utiliser le meme principe mais cellule sont séparées. A savoir ma liste de donnée est en B4, B6 et B8. Et là ton code ne fonctionne pas. J'ai essayé ainsi mais ca marche pas :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Private Sub Worksheet_Change(ByVal Target As Range) Set Intersection = Application.Intersect(Target, Range("$B$2;$B$9")) If Not (Intersection Is Nothing) And Target <> "" Then If IsError(Application.Match(Target.Value, [noms], 0)) Then If MsgBox("On ajoute?", vbYesNo) = vbYes Then [noms].End(xlDown).Offset(1, 0) = Target.Value Sheets("Feuil2").[noms].Sort key1:=Sheets("Feuil2").Range("A2") Else Application.Undo End If End If End If End Sub

---

Que faire stp???

Ahhh j'ai ajouté une virgule ca doit marcher je crois...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Private Sub Worksheet_Change(ByVal Target As Range) Set Intersection = Application.Intersect(Target, Range("$B$2,$B$9")) If Not (Intersection Is Nothing) And Target <> "" Then If IsError(Application.Match(Target.Value, [noms], 0)) Then If MsgBox("On ajoute?", vbYesNo) = vbYes Then [noms].End(xlDown).Offset(1, 0) = Target.Value Sheets("Feuil2").[noms].Sort key1:=Sheets("Feuil2").Range("A2") Else Application.Undo End If End If End If End Sub

---

Salut Airone784 et le forum

Code:

---

1 2 3 4 5

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Intersection As Range Set Intersection = Intersect(Target, Union([B4], [B6], [B8])) If Not (Intersection Is Nothing) Then MsgBox Intersection.Address(0, 0) End Sub

---

on n'aura un boite donnant l'adresse des cellules sélectionnées que si c'est une des trois (même en cas de multisélection=
A+

Bonjour à tous et merci à Gorfael pour tout coup de main,

J'ai un petit souci avec 2 code.
J'ai d'abord ce code

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Private Sub Worksheet_Change(ByVal Target As Range) Set Intersection = Application.Intersect(Target, Range("$G$3,$G$4,$G$5")) If Not (Intersection Is Nothing) And Target <> "" Then If IsError(Application.Match(Target.Value, [Produits], 0)) Then If MsgBox("On ajoute?", vbYesNo, "Essai") = vbYes Then [Produits].End(xlDown).Offset(1, 0) = Target.Value Sheets("Base_de_données").[Produits].Sort key1:=Sheets("Base_de_données").Range("C1") Else Application.Undo End If End If End If End Sub

---

Une fois que j'ai rempli mais cellule g3, g4, g5 je clique sur un bouton lançant cette macro :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Sub Effacer_saisie() ' ' Effacer_saisie Macro ' Macro enregistrée le 18/05/2007 par Airone '   '   Range("E3:H3,J3:K3,E4:H5,J4:J5,A3:B3,A4:D5").Select Range("A4").Activate Selection.ClearContents Range("A3").Select End Sub

---

Seul pb, j'ai un message m'indiquant : erreur d'éxecution 13 : incompatibilité de type.

Et lorsque je lance le debogage, est souligné en jaune la ligne : If Not (Intersection Is Nothing) And Target <> "" Then

Que se passe-t-il???

Merci de votre aide

Salut Airone784 et le forum
M'obligeant à déclarer mes variables, je me suis cantonné à la question

Code:

---

1 2 3 4 5 6

Private Sub Worksheet_Change(ByVal Target As Range) Set Intersection = Intersect(Target, Range("G3,G4,G5")) If Not (Intersection Is Nothing) And Target <> "" Then '..... End If End Sub

---

Citation:

---

erreur d'éxecution 13 : incompatibilité de type

---

n'apparaît que lorsque je fais du copier/coller (ou effacement) sur plus d'une cellule, ce qui est normal avec la partie du test target="" alors que target est un range d'au moins 2 cellules, donc dans ce cas, Excel ne considère plus le contenu (.value par défaut) mais les cellules.
Il faut mettre un discriminateur de cellule

Code:

---

1 2 3 4 5 6 7 8 9 10

Private Sub Worksheet_Change(ByVal Target As Range) dim Cel as range, Intersection as range Set Intersection = Intersect(Target, Range("G3,G4,G5")) If Intersection Is Nothing then exit sub for each Cel in Intersection if cel <> "" Then '..... End If next cel End Sub

---

par exemple. Le code n'a pas été testé : il est simple et ne devrait pas poser problème si on remplace target par Cel (dans la partie non mentionnée.

Code:

---

1 2 3 4

Sub Effacer_saisie() Range("E3:H3,J3:K3,E4:H5,J4:J5,A3:B3,A4:D5").ClearContents Range("A3").Select End Sub

---

Il faut être le plus concis possible : ne pas utiliser de Select et Activate sauf si c'est nécessaire.
Bien que ce ne soit aucunement nécessaire, je mets toujours la variable de boucle derrière le Next, pour m'y retrouver en cas d'imbrication.
A+

Merci Gorfael, je vais essayer tout ça!!! Super sympa en tout cas et bien calé, j'aimerai en savoir autant!!! :ccool: