UserForm
Bonjour,
Je dois réaliser des entretiens de travail et j'ai réalisé un tableau de saisie de la Base de données (feuille BD) dont les résultats se reportent dans la feuille "Entretien_Professionnel" selon un code d'appel en cellule J3 (couleur jaune)
Le problème que je rencontre, c'est la facilité de saisie et dans l'idéal, ça serait d'avoir un formulaire de saisie sur mesure.
Est ce quelqu'un saurait me donner un coup de main pour me réaliser ce formulaire de saisie qui est quand même assez conséquent ?
Dans l'attente de vos réponse, je vous remercie et vous souhaite une bonne journée,
Bien cordialement, Chti59xcel
Bonjour
Parole de chti !
1-
Tu peux simplifier tes formules de ce type :
=SI(RECHERCHEV($J$3;BD!$A$5:$DX$150;2;0)=0;"";RECHERCHEV($J$3;BD!$A$5:$DX$150;2;0))
en mettant juste
RECHERCHEV($J$3;BD!$A$5:$DX$150;2;0)
et en décochant la case des options avancées "Afficher un zéro ..."
2-
Je suppose que le feuille Entretien_Professionnel est une lecture !
Je propose aussi que ce soit le formulaire de saisie ... cela évite de créer un userform avec toutes les complications que cela suppose.
Dans ce cas, il faut créer une procédure événementielle qui répercutera la valeur dans la base de données et rétablira le formule pour la lecture.
Je regarderai dans ce sens dès que j'ai un moment de libre dans la journée.
Entre temps on verra d'autres propositions ... mais je hais les userform sauf dans des cas très particuliers.
Quelle est ta version d'excel ?
Peut-on passer en xlsx ou xlsm ?
Un bout d'essai
La seule macro est la suivante
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n%, trouve As Range
Application.EnableEvents = False
On Error GoTo fin ' pour le test du nom sur cellule
If Not Intersect(Target, Range("J3")) Is Nothing Then
Set trouve = Sheets("BD").Columns("A").Find(what:=Target.Value, LookAt:=xlWhole)
' si nouveau, on ajoute au bas de la liste
If trouve Is Nothing Then Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Target.Value
ElseIf Target.Name.Name Like "_col*" Then
Set trouve = Sheets("BD").Columns("A").Find(what:=Range("J3").Value, LookAt:=xlWhole)
n = Val(Mid(Target.Name.Name, 5, Len(Target.Name.Name) - 4))
Sheets("BD").Cells(trouve.Row, n) = Target.Value
Target.FormulaR1C1 = "=VLOOKUP(R3C10,BD!R5C1:R150C128," & n & ",0)"
End If
fin:
Application.EnableEvents = True
Exit Sub
End Sub
Il faut que tu continues à donner aux cellules les noms en _colXXX
où XXX est le numéro de la colonne dans BD comme j'ai commencé à le faire.
Bonjour,
Ok, merci pour ce début de réponse, j'ai compris la simplification de formule, ça c'est quelque chose que je peux faire facilement !
A bientôt, cordialement, Chti59xcel
Ma version Excel est 2007
A+, merci, Chti59xcel
ok
donc tu peux enregistrer tes fichiers au format xlsx et xlsm avec macros
ok pour la simplification de la formule
as-tu testé le formulaire (qui n'est autre que la feuille d'interrogation) ? il suffit d'écraser la formule avec le nouveau texte, la nouvelle date, la nouvelle valeur .... cela va se reporter dans ta BD et la formule va se remettre automatiquement.
Bonjour,
Voici une version moins "troublante" car il ne s'agit plus d'écraser les formules, mais juste modifier les valeurs. Les 2 onglets sont en permanence synchronisés.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n%, trouve As Range
Application.EnableEvents = False
On Error GoTo fin ' pour le test du nom sur cellule
If Not Intersect(Target, Range("J3")) Is Nothing Then
Set trouve = Sheets("BD").Columns("A").Find(what:=Target.Value, LookAt:=xlWhole)
' si nouveau, on ajoute au bas de la liste
If trouve Is Nothing Then Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Target.Value
For Each Nom In ThisWorkbook.Names
If Nom.Name Like "_col*" Then
n = Val(Mid(Nom.Name, 5, Len(Nom.Name) - 4))
Range(Nom.Name).Value = Sheets("BD").Cells(trouve.Row, n)
End If
Next
ElseIf Target.Name.Name Like "_col*" Then
Set trouve = Sheets("BD").Columns("A").Find(what:=Range("J3").Value, LookAt:=xlWhole)
n = Val(Mid(Target.Name.Name, 5, Len(Target.Name.Name) - 4))
Sheets("BD").Cells(trouve.Row, n) = Target.Value
End If
fin:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_Activate()
Dim n%, trouve As Range
Application.EnableEvents = False
Set trouve = Sheets("BD").Columns("A").Find(what:=Range("J3").Value, LookAt:=xlWhole)
For Each Nom In ThisWorkbook.Names
If Nom.Name Like "_col*" Then
n = Val(Mid(Nom.Name, 5, Len(Nom.Name) - 4))
Range(Nom.Name).Value = Sheets("BD").Cells(trouve.Row, n)
End If
Next
Application.EnableEvents = True
End Sub
Nota : je n'ai fait que la partie "Agent évalué", il faudrait donner des noms en _colXXX
aux autres zones modifiables (XXX étant le numéro de la colonne de la feuille BD)
Bonjour,
Merci pour l'envoi de cette nouvelle macro.
Je l'ai intégré dans mon classeur officiel et ça fonctionne.
J'ai nommé comme tu m'as dit mes colonnes et j'avais commencé à changé la formule, mais j'ai rencontré un problème, car j'avais déplacé en cellule K3 le code Agent qui se trouvait en cellule J3.
Avec cette nouvelle macro, le bug est réparé et j'ai remplacé à l'intérieur de cette macro J3 par K3.
Je finis la mise en forme et te renvoi le fichier pour avoir ton avis sur son fonctionnement et savoir si c'est opérationnel.
Encore un grand merci, bien cordialement, Chti59xcel
Re-bonjour,
Bon apparemment, le formulaire rencontre des difficultés.
En _col53, il m'affiche un message d'erreur #N/A ?
Ensuite, j'ai une petite question sur le mode d'utilisation.
Avec la nouvelle Macro, ça veut dire que je saisi directement dans le formulaire et il incrémente la BD.
Ensuite je n'ai plus qu'à appeler les infos à travers le code Agent en cellule K3 ou bien c'est l'inverse, je renseigne la BD et après j'appelle les infos dans le formulaire par le code Agent en cellule K3 ?
Merci, à bientôt, cordialement, Chti59xcel
Bon apparemment, le formulaire rencontre des difficultés.
En _col53, il m'affiche un message d'erreur #N/A ?
_col53 c'est bon,
fais juste un aller/retour entre les 2 feuilles une fois lors de la mise en place !
je pense que c'est le reliquat de la version précédente
vérifie aussi qu'il n'y a pas de #NA dans BD
Avec la nouvelle Macro, ça veut dire que je saisi directement dans le formulaire et il incrémente la BD.
Ensuite je n'ai plus qu'à appeler les infos à travers le code Agent en cellule K3 ou bien c'est l'inverse, je renseigne la BD et après j'appelle les infos dans le formulaire par le code Agent en cellule K3 ?
Oui c'est cela
Si tu ajoutes un code Agent inconnu, il l'ajoute dans BD
Après, tu saisis les infos dans l'un ou l'autre des onglets, ils seront synchronisés. Fais un essai et dis moi si tu trouves une anomalie (on n'est pas toujours à l'abri)
Hello, de retour
Sur le principe d'une saisie d'un côté ou de l'autre avec incrémentation dans la feuille BD ou dans la feuille Entretien_Professionnel après appel des données par le code Agent, c'est bon j'ai compris le principe et c'est super, car on a un double effet.
Par contre la synchronisation ne se fait pas toujours correctement et ça bug un peu, on dirait comme un problème de rafraîchissement des données ?
Affichage d'un bug macro :
Private Sub Worksheet_Activate()
Dim n%, trouve As Range
Application.EnableEvents = False
Set trouve = Sheets("BD").Columns("A").Find(what:=Range("K3").Value, LookAt:=xlWhole)
For Each Nom In ThisWorkbook.Names
If Nom.Name Like "_col*" Then
n = Val(Mid(Nom.Name, 5, Len(Nom.Name) - 4))
Range(Nom.Name).Value = Sheets("BD").Cells(trouve.Row, n)....................................... colorié en jaune ???
End If
Next
Application.EnableEvents = True
End Sub
Autre question : en cellules EA, EB et EC j'avais placé des informations à utiliser en liste déroulante dans la feuille BD quand l'information était redondante pour simplifier la saisie et limiter les risques d'erreurs. Du coup, je pensais transposer également cette solution de liste déroulante dans la feuille Entretien_Professionnel, puisqu'on peut saisir soit dans la feuille BD ou soit dans la feuille Entretien_Professionnel. Est ce que ça pose un problème au niveau de la macro ou autre ?
Je viens de faire un test avec une liste déroulante en feuille Entretien_Professionnel, cellule _col29, ça fonctionne.
Par contre, si je fais le chemin inverse, c'est à dire, si par exemple j'efface le contenu de la cellule _col29,
ensuite, je change le code Agent 1 pour faire venir les informations d'un code Agent 2 puis je reviens sur en arrière sur le code 'Agent 1 et bien il ré affiche les informations de la cellule _col29 malgré que je les avais effacé ?
Donc, problème... sur le rafraîchissement des données ou autre que je ne sais pas solutionner ? Je joins mon fichier pour voir les mises en place de données et de liste déroulante
A bientôt, merci, cordialement, Chti59xcel
Range(Nom.Name).Value = Sheets("BD").Cells(trouve.Row, n)....................................... colorié en jaune ???
je vais commencer par regarder ceci
dans la version précédente j'aais ajouté un on error goto ...
pour tenir compte que certaines cellules n'avaient pas de nom !
il faut que je le remette en cas de changement d'un libellé par exemple, mais je vais vérifier auparavant
humPar contre, si je fais le chemin inverse, c'est à dire, si par exemple j'efface le contenu de la cellule _col29,
Je ne m'attendais pas à cela !!
La macro détecte bien un effacement, mais dans ce cas elle n'accède pas au nom de la cellule ... je regarde pour contourner !
J'ai compris pourquoi, et aussi pourquoi je n'avais jamais rencontré cela ! C'est à cause de cellules fusionnées (que je n'utilise jamais car cela crée en effet un tas de problème, il vaut mieux faire centrer sur plusieurs colonnes) ...
Maintenant que je connais la cause, il faut trouver le remède en gardant les cellules fusionnées !
Voici en retour le fichier avec 2 corrections :
- l'effacement d'un item quand la cellule est fusionnée avec ses voisines en ajoutant
cells(1)
àtarget
- le bug de rafraichissement
Précision : la status bar (en bas de l'écran) indique la dernière action effectuée
Je n'ai pas touché aux listes déroulantes
Merci pour ces tests, car j'ai découvert quelques soucis auxquels je ne m'attendais pas ! (mais je dis tellement souvent de se méfier des cellules fusionnées que du reste je ne les utilise jamais).
N'hésite pas si tu trouves autre chose, car je pense qu'on tient là une solution intéressante pour éviter des userform.
J'ai pas mal ré-écrit le code ...
J'ai aussi défini le nom ID pour le code agent.
Option Explicit
Const prefixe = "_col"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim trouve As Range, nom As Name
Application.EnableEvents = False
With Sheets("BD")
Application.StatusBar = ""
If Not Intersect(Target, Range("ID")) Is Nothing Then
Set trouve = .Columns("A").Find(what:=Range("ID").Value, LookAt:=xlWhole)
If trouve Is Nothing Then
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Range("ID").Value
Application.StatusBar = Range("ID").Value & " ajouté !"
Set trouve = .Columns("A").Find(what:=Range("ID").Value, LookAt:=xlWhole)
End If
For Each nom In ThisWorkbook.Names
If nom.Name Like prefixe & "*" Then
Range(nom.Name).Value = .Cells(trouve.Row, col(nom.Name))
End If
Next
ElseIf lenom(Target) Like prefixe & "*" Then
Set trouve = .Columns("A").Find(what:=Range("ID").Value, LookAt:=xlWhole)
.Cells(trouve.Row, col(lenom(Target))) = Target.Cells(1).Value
Application.StatusBar = """" & .Cells(3, col(lenom(Target))) & .Cells(4, col(lenom(Target))) & """ mis à jour pour " & .Cells(trouve.Row, 4) & " " & .Cells(trouve.Row, 3) & " :: " & Target.Cells(1).Value
End If
fin:
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Activate()
Dim trouve As Range, nom As Name
Application.EnableEvents = False
With Sheets("BD")
Set trouve = .Columns("A").Find(what:=Range("ID").Value, LookAt:=xlWhole)
If trouve Is Nothing Then
Range("ID").Value = "" ' le code a été supprimé - on efface tout !
For Each nom In ThisWorkbook.Names
If nom.Name Like prefixe & "*" Then
Range(nom.Name).Value = ""
End If
Next
Else
For Each nom In ThisWorkbook.Names
If nom.Name Like prefixe & "*" Then
Range(nom.Name).Value = .Cells(trouve.Row, col(nom.Name))
End If
Next
End If
End With
Application.EnableEvents = True
End Sub
Function lenom(cel As Range) As String
' donne le nom affecté à la zone éventuellement fusionnée ou sà défaut son adresse
lenom = cel.Address
On Error Resume Next
lenom = cel.Cells(1).Name.Name
End Function
Function col(chaine As String) As Integer
' donne le numéro de colonne issu du nom de la zone
col = Val(Mid(chaine, Len(prefixe) + 1, Len(chaine) - Len(prefixe)))
End Function
Bonjour,
Merci pour cet envoi.
Je l'ai enregistré sur mon bureau et j'ai commencé à le tester. Au début impeccable, on a vraiment un classeur super fonctionnel et l'effet recherché avec la simplification entre deux feuilles pour saisir les données d'un côté ou de l'autre est vraiment une procédure géniale.
Ensuite, j'ai mis à jour les listes déroulantes dans les cellules qui étaient concernées, aussi bien dans la feuille BD que dans la feuille Entretien_Professionnel. Malheureusement quand j'ai voulu tester le changement des Agents, le fonctionnement c'est bloqué quelques soit l'appel du code Agent, les mises à jour ne se sont pas faites et je ne sais identifier d'où vient le problème ?
Je te remets mon fichier avec les dernières modifications que j'ai faites.
Merci pour ton aide et tes explications, à bientôt, Chti59xcel
Relance ton appli, cela va fonctionner à nouveau.
Ce que je te conseille, le temps de faire les modif que tu souhaites comme les menus déroulants, c'est d'ajouter exit sub juste après la ligne private sub
Private Sub Worksheet_Change(ByVal Target As Range)
Exit Sub
Private Sub Worksheet_Activate()
Exit Sub
Hello,
Je n'ai peut être pas bien compris, mais il faut que j'entre ces lignes de commande en attendant que tu modifies la Macro.
Ou alors, c'est moi qui aurait dû entrer ces lignes de commandes avant de modifier mes listes déroulantes ?
cordialement, Chti59xcel