Comment modifier la valeur d'une liste déroulante attachée à une cellule de feuille excel par VBA ?

Version imprimable

03/12/2017, 00h58
Floriane7522

Comment modifier la valeur d'une liste déroulante attachée à une cellule de feuille excel par VBA ?

bonsoir,
Dans mon classeur, j'ai un onglet "base de données des 400 agents de ma société qui comporte notamment l'identité de chaque agent (une ligne par agent). Dans le même fichier j'ai un autre onglet servant de formulaire. Dans ce formulaire j'ai créé une liste déroulante par le menu excel Données/validation de données qui est liée à la liste de mes agents située dans l'onglet "base de données". Cet onglet formulaire comporte plusieurs données relatives à l'agent (nom, date de naissance, métier, salaire.....) Lorsque je sélectionne un agent, les données de cet agent s'affichent aussitôt dans le formulaire grâce à la formule "=recherchev". Il y a également d'autres informations qui sont le croisement des données de la base de données mais qui ne figurent pas dedans.
Tout cela fonctionne bien tant que je sélectionne chaque agent un à un avec ma souris.

OR, j'ai besoin de synthétiser toutes les données de chaque agent dans un journal, toutes les données c'est-à-dire celles provenant de la base de données et celles qui se croisent et qui se calculent en fonction des informations de chaque agent.
J'ai rédigé quelques lignes de code en vba pour "exporter" pour chaque agent les données dont j'ai besoin dans un 3ème onglet appelé "Journal".

VBA doit donc sélectionner à ma place chaque agent dans la liste déroulante de la feuille excel avant d'envoyer les données calculées dans le journal. J'ai programmé un "copier-coller" dans la cellule concernée. D'une part cela efface la liste déroulante et d'autre part, les formules "=recherchev" ne se mettent plus à jour. BIGRE !

Quelqu'un aurait-il la clef de mon problème pour modifier la valeur de la liste déroulante automatiquement ?
Merci d'avance pour vos réponses
Floriane

Citation:

Envoyé par Floriane7522

Bonjour,

Le fichier joint contient le code suivant que vous pourriez adapter :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub LancerLaBoucleNomsPrenoms()
 
Dim AireNomsPrenoms As Range, CelluleNomsPrenoms As Range, CelluleCible As Range
'Dim I As Long
 
    Set AireNomsPrenoms = Sheets("Source").Range("NomsPrenoms")
    Set CelluleCible = Sheets("Cible").Range("NomPrenomChoisi")
 
 '   I = 0
    For Each CelluleNomsPrenoms In AireNomsPrenoms
 
        CelluleCible = CelluleNomsPrenoms
  '      If I <= 5 Then MsgBox CelluleCible
 
  '      I = I + 1
 
    Next CelluleNomsPrenoms
 
    Set AireNomsPrenoms = Nothing
    Set CelluleCible = Nothing
 
End Sub

03/12/2017, 17h45
Floriane7522

1 pièce(s) jointe(s)

Bonjour Eric,
Merci pour votre aide. :D
C'est presque ce dont j'ai besoin, il manque dans votre proposition un onglet. Comme je ne me suis pas très bien exprimée, j'ai repris votre classeur et je l'ai complété en rajoutant mon formulaire et en pré remplissant l'onglet cible pour mieux exprimer mon besoin et permettre de comprendre le résultat final.
je vous ai retourné votre classeur au cas où pourriez faire un nouvel examen.
merci pour votre réponse
bien cordialement
Florence
03/12/2017, 19h49
Invité

Citation:

Envoyé par Floriane7522

Bonsoir,

Quel est l'intérêt d'un formulaire ? Vous pourriez réaliser vos calculs directement dans l'onglet journal, non ?
03/12/2017, 19h55
Floriane7522

Citation:

Envoyé par Eric KERGRESSE

Bonsoir,

Quel est l'intérêt d'un formulaire ? Vous pourriez réaliser vos calculs directement dans l'onglet journal, non ?

En fait, le formulaire (comportant beaucoup plus de données en réalité) va être remis à chaque salarié de l'entreprise. Parallèlement, j'ai besoin d'un journal (ce que vous appelez cible) qui résume pour chaque salarié certaines données et apporte en sus des calculs (je n'ai pas tout mis dans l'onglet car cela n'apporte rien de plus à l'exercice), l'objectif de l'onglet cible étant :
- de quantifier financièrement ce qui faut rajouter unitairement et globalement par type d'emplois pour la fin de l'exercice annuel
- de faire des statistiques ensuite sur les niveaux de rémunération en fonction de l'âge et d'autres paramètres.
merci
florence

Citation:

Envoyé par Floriane7522

Il ne vous reste plus qu'à compléter le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Option Explicit
 
Sub MettreAJourLeJournal(ByVal FeuilleFormulaire As Worksheet)
 
Dim AireNomsPrenoms As Range, CelluleNomsPrenoms As Range
 
    Set AireNomsPrenoms = Sheets("Journal").Range("NomsPrenoms")
    For Each CelluleNomsPrenoms In AireNomsPrenoms
 
        If CelluleNomsPrenoms = FeuilleFormulaire.Range("NomPrenomChoisi") Then
 
           CelluleNomsPrenoms.Offset(0, 2) = FeuilleFormulaire.Range("AgentAge")
           CelluleNomsPrenoms.Offset(0, 3) = FeuilleFormulaire.Range("AgentQuotite")
           ' A compléter avec le reste des zones nommées du formulaire (en jaune)
 
           Exit For
 
        End If
 
    Next CelluleNomsPrenoms
    Set AireNomsPrenoms = Nothing
 
End Sub

Citation:
Envoyé par Eric KERGRESSE
Il ne vous reste plus qu'à compléter le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Option Explicit Sub MettreAJourLeJournal(ByVal FeuilleFormulaire As Worksheet) Dim AireNomsPrenoms As Range, CelluleNomsPrenoms As Range Set AireNomsPrenoms = Sheets("Journal").Range("NomsPrenoms") For Each CelluleNomsPrenoms In AireNomsPrenoms If CelluleNomsPrenoms = FeuilleFormulaire.Range("NomPrenomChoisi") Then CelluleNomsPrenoms.Offset(0, 2) = FeuilleFormulaire.Range("AgentAge") CelluleNomsPrenoms.Offset(0, 3) = FeuilleFormulaire.Range("AgentQuotite") ' A compléter avec le reste des zones nommées du formulaire (en jaune) Exit For End If Next CelluleNomsPrenoms Set AireNomsPrenoms = Nothing End Sub
-----------------------------------------
Bonjour Erik,
Merci c'est tout à fait cela dont j'avais besoin. Il ne manque qu'une seule chose c'est le changement du nom de l'agent en B1 par VBA de façon automatique pour que je n'ai pas à le faire pour mes 400 salariés : une routine qui change le nom et ensuite transfère le nom dans le journal avec les données liées. Si vous pouviez ajouter cette fonctionnalité ;-)
Merci encore pour votre aide, c'est super sympa !
Belle journée à vous
Florence

04/12/2017, 08h57
Invité
Citation:

Envoyé par Floriane7522

Il suffit de supprimer le If then... if et le Exit for de :
Code:

1 2 If CelluleNomsPrenoms = FeuilleFormulaire.Range("NomPrenomChoisi") Then
Et d'assigner la valeur FeuilleFormulaire.Range("NomPrenomChoisi") à CelluleNomsPrenoms dans la boucle :

Code:

FeuilleFormulaire.Range("NomPrenomChoisi") = CelluleNomsPrenoms
04/12/2017, 20h21
Floriane7522

1 pièce(s) jointe(s)
Citation:
Envoyé par Eric KERGRESSE

Il suffit de supprimer le If then... if et le Exit for de :

Code:

1 2 If CelluleNomsPrenoms = FeuilleFormulaire.Range("NomPrenomChoisi") Then

Et d'assigner la valeur FeuilleFormulaire.Range("NomPrenomChoisi") à CelluleNomsPrenoms dans la boucle :

Code:

FeuilleFormulaire.Range("NomPrenomChoisi") = CelluleNomsPrenoms
bonsoir,
Je dois être particulièrement mal emmanchée mais cela ne fonctionne pas. Cela ne me copie que le dernier nom de la liste sur la ligne de tous les noms :-(
Je vous ai joint le fichier avec le code modifié...
Je ne comprends pas.
Merci pour votre retour
florence
05/12/2017, 05h37
Invité

Citation:

Envoyé par Floriane7522

Remettez le calcul automatique dans vos options.
Pour quelle raison ce paramètre est-il en manuel ?
11/12/2017, 08h46
Floriane7522

bonjour,
Je viens de tester ce week-end et cela fonctionne parfaitement bien ! tout à fait ce dont j'avais besoin. Merci encore pour votre aide répétitive.
bonne journée à vous
florence