Bonjour à tous,
voici mon problème : je crée une petite base de données destinée à enregistrer des données qui concernent des associations sportives (leur coordonnées, disciplines d'affiliation (athlé, foot,tennis,...), ...
J'ai donc plusieurs feuilles :
- les données sources (BD)
- une feuille "menu" pour pouvoir naviguer vers les différents onglets
- une feuille "création" pour pouvoir créer une nouvelle fiche "association"
- une feuille "consultation" qui me permet de consulter ou modifier une fiche existante.
- 2 feuilles "liste" où sont répertoriées les différentes listes (disciplines, associations, communes, code postaux) me permettant de renseigner ces cellules par le biais de listes déroulantes (ces listes étant dynamiques).
Jusque-là tout va bien.
Mon soucis est le suivant : lors de la saisie d'une nouvelle discipline et/ou d'une nouvelle association, d'une nouvelle commune ou d'un nouveau code postal ( feuille "création" ou consultation/modification" ), je voudrais que ces nouvelles données soient automatiquement placées dans la liste déroulante concernée et, si possible, dans l'ordre alphabétique .
Pour cela, j'ai trouvé une macro proposée sur son site par Jacques Boisgontier (liste en cascade avec ajout dynamique de champs).
http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DV_CascadeSansNomsAjoutDynamique.xls
J'ai essayé de l'adapter aux spécificités de ma requête mais, ne maîtrisant pas langage vba, je patauge complétement.
Voici la macro de Jacques Boisgontier ( merci à toi au passage !):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" And Target <> "" And Target.Count = 1 Then
If IsError(Application.Match(Target.Value, [choix1], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[choix1].End(xlToRight).Offset(0, 1) = Target.Value
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
Else
Target.Offset(0, 1) = Sheets("listes").Range("choix2")(1).Offset(1, Application.Match(Target, [choix1], 0) - 1)
End If
End If
If Target.Address = "$C$2" And Target <> "" And Target.Count = 1 Then
d = Application.Match(Target.Offset(0, -1), [choix1], 0) - 1
If IsError(Application.Match(Target.Value, [choix2].Offset(0, d), 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
n = Application.CountA([choix2].Offset(0, d))
c = Sheets("listes").Range("choix2").Column
Sheets("listes").Cells(n + 1, c + d) = Target.Value
Else
On Error Resume Next
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End If
End Sub
Voici ma tentative d'adaptation :
Sub ajouter_donnees()
If Target.Address = "$E$6" And Target <> "" And Target.Count = 1 Then
If IsError(Application.Match(Target.Value, [disciplines], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[disciplines].End(xlToRight).Offset(0, 1) = Target.Value
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
Else
Target.Offset(0, 1) = Sheets("liste disc-ass").Range("associations")(1).Offset(1, Application.Match(Target, [choix1], 0) - 1)
End If
End If
If Target.Address = "$E$7" And Target <> "" And Target.Count = 1 Then
d = Application.Match(Target.Offset(0, -1), [disciplines], 0) - 1
If IsError(Application.Match(Target.Value, [associations].Offset(0, d), 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
n = Application.CountA([associations].Offset(0, d))
c = Sheets("liste disc-ass").Range("associations").Column
Sheets("liste disc-ass").Cells(n + 1, c + d) = Target.Value
Else
On Error Resume Next
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End If
End Sub
Je ne sais pas d'où vient le problème (je m'y prend mal pour enregistrer la macro, je ne sais pas l'adapter, la lancer ?).
Merci de me donner un coup de main car là je suis bloqué !
Je vous ai joint mon fichier que j'ai auparavant converti au format 97-2003
voici mon problème : je crée une petite base de données destinée à enregistrer des données qui concernent des associations sportives (leur coordonnées, disciplines d'affiliation (athlé, foot,tennis,...), ...
J'ai donc plusieurs feuilles :
- les données sources (BD)
- une feuille "menu" pour pouvoir naviguer vers les différents onglets
- une feuille "création" pour pouvoir créer une nouvelle fiche "association"
- une feuille "consultation" qui me permet de consulter ou modifier une fiche existante.
- 2 feuilles "liste" où sont répertoriées les différentes listes (disciplines, associations, communes, code postaux) me permettant de renseigner ces cellules par le biais de listes déroulantes (ces listes étant dynamiques).
Jusque-là tout va bien.
Mon soucis est le suivant : lors de la saisie d'une nouvelle discipline et/ou d'une nouvelle association, d'une nouvelle commune ou d'un nouveau code postal ( feuille "création" ou consultation/modification" ), je voudrais que ces nouvelles données soient automatiquement placées dans la liste déroulante concernée et, si possible, dans l'ordre alphabétique .
Pour cela, j'ai trouvé une macro proposée sur son site par Jacques Boisgontier (liste en cascade avec ajout dynamique de champs).
http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DV_CascadeSansNomsAjoutDynamique.xls
J'ai essayé de l'adapter aux spécificités de ma requête mais, ne maîtrisant pas langage vba, je patauge complétement.
Voici la macro de Jacques Boisgontier ( merci à toi au passage !):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" And Target <> "" And Target.Count = 1 Then
If IsError(Application.Match(Target.Value, [choix1], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[choix1].End(xlToRight).Offset(0, 1) = Target.Value
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
Else
Target.Offset(0, 1) = Sheets("listes").Range("choix2")(1).Offset(1, Application.Match(Target, [choix1], 0) - 1)
End If
End If
If Target.Address = "$C$2" And Target <> "" And Target.Count = 1 Then
d = Application.Match(Target.Offset(0, -1), [choix1], 0) - 1
If IsError(Application.Match(Target.Value, [choix2].Offset(0, d), 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
n = Application.CountA([choix2].Offset(0, d))
c = Sheets("listes").Range("choix2").Column
Sheets("listes").Cells(n + 1, c + d) = Target.Value
Else
On Error Resume Next
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End If
End Sub
Voici ma tentative d'adaptation :
Sub ajouter_donnees()
If Target.Address = "$E$6" And Target <> "" And Target.Count = 1 Then
If IsError(Application.Match(Target.Value, [disciplines], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[disciplines].End(xlToRight).Offset(0, 1) = Target.Value
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
Else
Target.Offset(0, 1) = Sheets("liste disc-ass").Range("associations")(1).Offset(1, Application.Match(Target, [choix1], 0) - 1)
End If
End If
If Target.Address = "$E$7" And Target <> "" And Target.Count = 1 Then
d = Application.Match(Target.Offset(0, -1), [disciplines], 0) - 1
If IsError(Application.Match(Target.Value, [associations].Offset(0, d), 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
n = Application.CountA([associations].Offset(0, d))
c = Sheets("liste disc-ass").Range("associations").Column
Sheets("liste disc-ass").Cells(n + 1, c + d) = Target.Value
Else
On Error Resume Next
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End If
End Sub
Je ne sais pas d'où vient le problème (je m'y prend mal pour enregistrer la macro, je ne sais pas l'adapter, la lancer ?).
Merci de me donner un coup de main car là je suis bloqué !
Je vous ai joint mon fichier que j'ai auparavant converti au format 97-2003
