Discussion :

[Airone784]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Jean-Philippe André]

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

[EmmanuelleC]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Pierre Fauconnier]

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

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, ...)

[Airone784]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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???

[Airone784]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Gorfael]

Salut Airone784 et le forum

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[Airone784]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Gorfael]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[Airone784]

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