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

32formulaire.zip (31.69 Ko)

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.

capture d ecran 455
17formulaire.xlsm (46.53 Ko)

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)

12formulaire-v2.xlsm (47.98 Ko)

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

Par contre, si je fais le chemin inverse, c'est à dire, si par exemple j'efface le contenu de la cellule _col29,

hum

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

Rechercher des sujets similaires à "userform"