Help: Incrémenter une ligne d'un objet Tableau + Modification d'une base via une recherche

Version imprimable

07/04/2021, 14h49
laurentdx59

1 pièce(s) jointe(s)

Help: Incrémenter une ligne d'un objet Tableau + Modification d'une base via une recherche

Bonjour à tous,

Tout d'abord, un grand merci si vous lisez mon message.

Voici ma problématique: j'ai créé un fichier pour le suivi de mes sous-traitants. Sur ce fichier, il y a deux onglets:

- FORM: qui sert à l'enregistrement d'un sous Traitant ET (mais je n'y arrive pas) à modifier une ligne d'un sous Traitant existant
- BDD: qui est ma base de donnée

Utilisation: le but est donc de saisir les différents champs dans "FORM". Quand je clique sur le bouton "Créatin", une ligne va venir s'incrémenter dans mon onglet BDD.

1er problématique: cela fonctionne mais je souhaite que ma base de donnée dans l'onglet BDD soit sous forme de l'outil TABLEAU. Or, la ligne qui vient s'incrémenter se rajoute en dessous du Tableau créé et non dans le Tableau. Comment pourrais je faire? Cela me permettrait notamment de faire glisser mes formules sur l'onglet BDD entre les colonnes V et AH.

2eme problématique: Sur l'onglet FORM, je souhaite pouvoir modifier une ligne existante. Mon souhait serait donc de sélectionner un sous Traitant sur la cellule N7 de l'onglet FORM et que les informations apparaissent sur les différents champs de mon "formulaire". Une fois que j'apporte mes modifications, celles-ci doivent être mise à jour dans ma base de données.
Mais là, idem, je pense être trop débutant pour savoir faire cela. Pourriez vous m'aider?

Je vous remercie beaucoup pour votre aide.

Je vous mets mon fichier actuel en PJ.

Bien à vous,

Laurent

1 pièce(s) jointe(s)

Salut

Voici un exemple à adapter à ton cas.

Au départ, un tableau t_contacts, une zone de saisie (En B1, B3 et B5) nommée Saisie composée des cellules nommées Saisie_ID, Saisie_Nom, Saisie_Prénom (ici sur la même feuille pour les besoins de l'illustration, mais tu remarques que nul part je ne parle de la place des cellules, l'utilisation des alias et références structurées permettant de les déplacer sans toucher au code). Deux boutons connectés aux procédures Save et Retrieve sont placés sur le "formulaire"

Pièce jointe 595130

Voici un code très simple qui utilise Excel( références structurées, fonction EQUIV - Match en anglais) (D'abord penser EXCEL avant de penser VBA)
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 25 26 27 28 29 30 31 32 33 34 35 Option Explicit Sub Save() Dim Index As Long Index = Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)") If Index = 0 Then Index = Range("t_Contacts").ListObject.ListRows.Add.Index WriteData Index End Sub Sub WriteData(Index As Long) Range("t_Contacts[ID]")(Index).Value = Range("Saisie_ID").Value Range("t_Contacts[Nom]")(Index).Value = Range("Saisie_Nom").Value Range("t_Contacts[Prénom]")(Index).Value = Range("Saisie_Prénom").Value Range("saisie").ClearContents End Sub Sub Retrieve() Dim ID As Long ID = Range("saisie_id").Value If ReadData(ID) = 1 Then MsgBox "Identifiant inexistant", vbExclamation, "Recherche d'un contact" End Sub Function ReadData(ID As Long) As Long Dim Row As Long Dim Source As Range Row = Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)") If Row > 0 Then Range("saisie_Nom").Value = Range("t_Contacts[Nom]")(Row).Value Range("saisie_Prénom").Value = Range("t_Contacts[Prénom]")(Row).Value Else ReadData = 1 End If End Function
Ici, j'ai montré le mécanisme général, pas les vérifications d'usage, dont par exemple le fait d'avoir bien saisi un ID numérique en B1. C'est à toi d'adapter.

Si on a beaucoup de paires cellules/colonnes, on pourrait se baser sur un array de paires Clés/Valeurs ou une table de mappage (cfr ce message).

08/04/2021, 19h19
laurentdx59
Bonjour Pierre,

Merci pour cet exemple. Je suis en train de le décortiquer. L'avantage en plus est que cela passerait par une base en format Tableau.

Pour la partie "Save", je pense avoir bien saisi la mécanique et je vais pouvoir l'adapter à mon fichier.

Là je bloque sur la partie
Code:

1 2 3 4 5 Sub Retrieve() Dim ID As Long ID = Range("saisie_id").Value If ReadData(ID) = 1 Then MsgBox "Identifiant inexistant", vbExclamation, "Recherche d'un contact" End Sub
En effet, cela ne semble pas fonctionner quand je lance la Macro. Je vais creuser.

Si je peux me permettre, est-ce qu'il y aurait un moyen de ne pas pouvoir ajouter de ligne si le sous traitant est déjà dans ma base? En fait, je souhaiterais que, quand on tape l'ID (dans ton exemple), si celui si se trouve dans la base, alors un message apparait pour m'en informer et cela stop la macro.

Bien à toi

Laurent

Dans une autre discussion, j'avais repris le code que je t'ai donné et je l'avais commenté. Le voici.

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub Save()
  ' Cherche si l'identifiant saisi existe grâce à la formule EQUIV (englobée dans un SIERREUR)
  Dim Index As Long
 
  Index = Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)") ' Renvoie la ligne du tableau si ID existe, sinon 0
  If Index = 0 Then Index = Range("t_Contacts").ListObject.ListRows.Add.Index ' Si 0, crée une nouvelle ligne dans le tableau structuré
  WriteData Index ' Appelle la procédure WRITE en lui passant le numéro de la ligne à modifier
End Sub
 
Sub WriteData(Index As Long)
  ' Transfère les données du formulaire dans la ligne du tableau souhaitée, cellule par cellule
  Range("t_Contacts[ID]")(Index).Value = Range("Saisie_ID").Value ' Transfère le contenu de la cellule du formulaire qui contient l'ID sur la ligne souhaitée, dans la colonne de l'ID
  Range("t_Contacts[Nom]")(Index).Value = Range("Saisie_Nom").Value ' Idem pour le nom
  Range("t_Contacts[Prénom]")(Index).Value = Range("Saisie_Prénom").Value ' Idem pour le prénom
  Range("saisie").ClearContents ' Nettoie la zone de saisie
End Sub
 
Sub Retrieve()
  ' Récupère le numéro de la ligne de l'ID pour les données que l'on veut transmettre au formulaire
  ' Transfère la ligne de l'ID si trouvée, sinon on affiche un message d'erreur
  Dim ID As Long
  ID = Range("saisie_id").Value ' Récupération de l'identifiant saisi dans le formulaire
  If ReadData(ID) = 1 Then MsgBox "Identifiant inexistant", vbExclamation, "Recherche d'un contact" ' appelle la fonction ReadData en lui passant l'ID et teste le résultat. Si 0, OK, si 1, affichage du message
End Sub
 
Function ReadData(ID As Long) As Long
  ' Recherche l'ID dans la colonne ID du tableau et si trouvé, transfère les données dans le formulaire et renvoie 0. Si pas trouvé, renvoie 0
  Dim Row As Long
  Dim Source As Range
 
  Row = Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)") ' Recherche de la cellule qui contient l'ID avec une formule EQUIV (MATCH en anglais)
  If Row > 0 Then ' SI le numéro de la ligne est >0, l'ID existe et on transfère
    Range("saisie_Nom").Value = Range("t_Contacts[Nom]")(Row).Value ' Transfert du contenu de la colonne Nom du tableau pour la ligne trouvée
    Range("saisie_Prénom").Value = Range("t_Contacts[Prénom]")(Row).Value ' Idem pour le prénom
  Else ' La ligne n'a pas été trouvée car l'ID n'existe pas dans le tableau
    ReadData = 1 ' ReadData renvoi1 pour informer la procédure appelante que le transfert n'a pas pu être effectué
  End If
End Function

Citation:

Envoyé par laurentdx59

[...]
En effet, cela ne semble pas fonctionner quand je lance la Macro. Je vais creuser.[...]

Il faut noter qu'avec Evaluate, on recompose les arguments de la fonction EQUIV (MATCH) comme en Excel, donc en différenciant les valeurs de type texte et de type numérique. On pourrait remplacer les Evaluate... par Application.Match(Range("saisie_ID").Value, Range("t_Contacts[id]"), 0) 'Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)")

Si on veut tendre vers du générique, les WriteData et ReadData devraient recevoir l'index de la ligne en entier long, à charge pour les procédures qui les appellent de déterminer l'index de la ligne. Ca correspondrait mieux à une architecture "bonnes pratiques" ou une fonction n'a qu'un seul rôle...

Dès lors, Save et Retrieve ont comme rôle de rechercher l'index voulu et d'appeler la procédure qui transfère les données dans un sens ou dans l'autre. Voici un code qui respecte mieux cela:

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
25
26
27
28
29
30
31
32
Sub Save()
  Dim Index
 
  Index = Application.Match(Range("saisie_ID").Value, Range("t_Contacts[id]"), 0) 'Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)")
  If IsError(Index) Then Index = 0
  If Index = 0 Then Index = Range("t_Contacts").ListObject.ListRows.Add.Index
  WriteData CLng(Index)
End Sub
 
Sub WriteData(Index As Long)
  Range("t_Contacts[ID]")(Index).Value = Range("Saisie_ID").Value
  Range("t_Contacts[Nom]")(Index).Value = Range("Saisie_Nom").Value
  Range("t_Contacts[Prénom]")(Index).Value = Range("Saisie_Prénom").Value
  Range("saisie").ClearContents
End Sub
 
Sub Retrieve()
  Dim ID
  ID = Application.Match(Range("saisie_ID").Value, Range("t_Contacts[id]"), 0) 'Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)")
  If ReadData(CLng(ID)) = 1 Then MsgBox "Identifiant inexistant", vbExclamation, "Recherche d'un contact"
End Sub
 
Function ReadData(Index As Long) As Long
  Dim Source As Range
 
  If Index > 0 Then
    Range("saisie_Nom").Value = Range("t_Contacts[Nom]")(Index).Value
    Range("saisie_Prénom").Value = Range("t_Contacts[Prénom]")(Index).Value
  Else
    ReadData = 1
  End If
End Function

Citation:

Envoyé par laurentdx59

[...]
Si je peux me permettre, est-ce qu'il y aurait un moyen de ne pas pouvoir ajouter de ligne si le sous traitant est déjà dans ma base? En fait, je souhaiterais que, quand on tape l'ID (dans ton exemple), si celui si se trouve dans la base, alors un message apparait pour m'en informer et cela stop la macro.[...]

Normalement, c'est le fonctionnement de mon code, puisque l'index de la ligne sur laquelle pousser les données est calculé par EQUIV (en VBA) pour retrouver la ligne existante ou créer la nouvelle. Cela permet de mettre à jour les données du contact.

Voici en exemple la procédure Save adaptée pour demander à l'utilisateur s'il veut remplacer les données... Tu remarqueras que l'architecture découpée en fonctions "monorôle" permet de ne modifier que cette procédure...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub Save() Dim Index Dim Answer As VbMsgBoxResult Index = Application.Match(Range("saisie_ID").Value, Range("t_Contacts[id]"), 0) 'Evaluate("iferror(match(" & Range("saisie_ID").Value & ",t_Contacts[ID],0),0)") If IsError(Index) Then Index = 0 If Index = 0 Then Index = Range("t_Contacts").ListObject.ListRows.Add.Index Answer = vbYes Else Answer = MsgBox("Ce contact existe. Voulez-vous remplacer les données", vbQuestion + vbYesNo, "Enregistrement") End If If Answer = vbYes Then WriteData CLng(Index) End Sub

12/04/2021, 12h27
laurentdx59

Bonjour Pierre,

Merci beaucoup pour cette aide. Je suis en train de rebâtir mon fichier en partant de tes instructions pour comprendre le code et son fonctionnement. (Je suis néophyte donc je ne comprends pas tous les termes employés :) )

Je te tiens au courant de mon avancée :)

Bonne journée
22/04/2021, 12h41
laurentdx59

1 pièce(s) jointe(s)

Pierre Bonjour,

Avec un peu de latence, j'ai pu enfin reprendre mon fichier et m'inspirer de ton code pour le rendre fonctionnel.

Je te remercie pour ton aide.

Pour info, j'ai dû reprendre ta première proposition avec Evaluate pour éviter d'avoir des doublons car, étrangement, l'autre méthode fonctionnait si je fais référence au nom de l'artisan mais pas si je faisais référence à un SIREN déjà existant.

Je ne sais pas trop pourquoi. Mais en tout cas, avec la fonction Evaluate, cela fonctionne.

Voici donc mon fichier pour info :)

Bonne journée,

Laurent
22/04/2021, 12h48
Pierre Fauconnier

Merci d'être venu dire que c'était ok. C'est toujours intéressant pour les lecteurs du forum de savoir que les propositions formulées correspondaient aux attentes.

Pense à passer le sujet en :resolu: si ce problème est clos ;)

Bonne continuation et peut-être à bientôt
03/05/2021, 15h30
laurentdx59

1 pièce(s) jointe(s)

Bonjour Pierre,

Suite à une mise en application de mon "formulaire", je rencontre un soucis qui me bloque au niveau de la modification d'une ligne existante.

En effet, sur mon fichier, lorsque je cherche un contact pour modification, je suis embêté avec le critère "SIREN": si je modifie le numéro de SIREN, une nouvelle ligne va s'ajouter à mon tableau si je valide. Alors que je souhaite simplement que ce numéro soit modifié sur la ligne déjà existante.

Je ne sais pas comment faire. Aurais tu une piste?

Merci

Laurent