Discussion :

[cyroulette]

bonjour à tous,
je me suis fait un formulaire de machines lorsque je veux rappeler une machine pour la modifier, je met la formule suivante dans chaque case correspondantes aux données que je veux faire apparaître =SI(ESTVIDE(D6);"";RECHERCHEV(D6;machines!B:P;3;FAUX)) j'affiche ainsi des données déjà enregistrer pour une machine par exemple si je modifie ainsi une valeur j'aimerais que cela me l'enregistre dans la ligne correspondant déjà à la machine sans me créer un nouvel enregistrement.
comment faire svp?
d'avance merci à ceux qui pourront m'aider

[Pierre Fauconnier]

Salut.

Dans ce billet de blog, j'explique une technique possible pour transférer les données d'un formulaire "feuille de calcul" à un tableau. Dans cet autre billet, j'explique comment travailler dans l'autre sens, pour remplacer tes RECHERCHEV.

J'espère que cela pourra t'aider.

Je vois que ta formule RECHERCHEV utilise B. Je ne saurais trop te conseiller d'utiliser des tableaux structurés.

[cyroulette]

bonsoir,
la je bloque complet, en plus avec des macro j'ai l'impression que ca fait lourd, tout clignote pendant l'enregistrement.

[Pierre Fauconnier]

Voici deux codes qui permettent de lire des données d'une table pour les placer dans un formulaire "feuille de calcul" et pour faire l'inverse, écrire les données du formulaire "feuille de calcul" dans une table, soit en écrasant les données présentes, soit en les ajoutant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Read()
  Dim Pos
  Dim map
  Dim i As Long
 
  Pos = Application.Match(Range("f_Machine").Value, Range("t_Machines[Machine]"), 0)
  Range("Formulaire").ClearContents
  If Not IsError(Pos) Then
    map = VBA.Array("f_Machine", "Machine", "f_Libellé", "Désignation", "f_Largeur", "Largeur (m)", "f_Longueur", "Longueur (m)")
    For i = 0 To UBound(map) Step 2
      Range(map(i)).Value = Range("t_Machines[" & map(i + 1) & "]")(Pos).Value
    Next i
  Else
    MsgBox "Cette machine n'existe pas", vbExclamation
  End If
End Sub
 
Sub Save()
  Dim Pos
  Dim map
  Dim i As Long
  Dim Answer As VbMsgBoxResult
 
  Pos = Application.Match(Range("f_Machine").Value, Range("t_Machines[Machine]"), 0)
  If IsError(Pos) Then
    Answer = MsgBox("Cette machine n'existe pas. Voulez-vous la créer?", vbQuestion + vbYesNo)
    If Answer = vbYes Then Pos = Range("t_Machines").ListObject.ListRows.Add.Index
  End If
  If Not IsError(Pos) Then
    map = VBA.Array("f_Machine", "Machine", "f_Libellé", "Désignation", "f_Largeur", "Largeur (m)", "f_Longueur", "Longueur (m)")
    For i = 0 To UBound(map) Step 2
      Range("t_Machines[" & map(i + 1) & "]")(Pos).Value = Range(map(i)).Value
    Next i
  End If
End Sub

Elles fonctionnent dans le cadre du fichier joint, puisque l'array de mappage (qui apparie les cellules du formulaire et les colonnes de la table) ainsi que le nom de la table est en dur. Pour récupérer les données d'une machine, il faut simplement saisir son code dans la cellule correspondante du formulaire. Pour la facilité de manipulation, le tableau et le formulaire sont sur la même feuille, mais tu peux les déplacer sans devoir modifier le code.

[Pierre Fauconnier]

[...]en plus avec des macro j'ai l'impression que ca fait lourd, tout clignote pendant l'enregistrement.

Tu peux placer Application.ScreenUpdating = False en début de macro et le remettre à True en fin de macro. Ca accélérera l'exécution et l'écran sera figé durant le processus


Dans mon billet, je parle de généraliser le code, ce qui est utile lorsque plusieurs paires formulaire/table existent.

Dans le fichier suivant, on a la paire f_Machine/t_Machines et la paire f_Contact/t_Contacts. On va voir que les codes de lecture et d'écriture, réduits à une simple boucle, fonctionnent pour les deux paires grâce à l'array de mappage.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Read(ByVal Tablename As String, ByVal Pos As Long, Map)
  Dim i As Long
 
  For i = 0 To UBound(Map) Step 2
    Range(Map(i)).Value = Range(Tablename & "[" & Map(i + 1) & "]")(Pos).Value
  Next i
End Sub
 
Sub Save(ByVal Tablename As String, ByVal Pos As Long, Map)
  Dim i As Long
 
  For i = 0 To UBound(Map) Step 2
    Range(Tablename & "[" & Map(i + 1) & "]")(Pos).Value = Range(Map(i)).Value
  Next i
End Sub

Ces procédures génériques sont appelées par les procédures particulières ReadMachine, SaveMachine, ReadContact et SaveContact qui leur passent les arguments adéquats.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
39
40
41
Sub ReadMachine()
  Dim Pos
  Dim Map
 
  Map = VBA.Array("Machines!Machine", "Machine", "Machines!Libelle", "Désignation", "Machines!Largeur", "Largeur (m)", "Machines!Longueur", "Longueur (m)")
  Pos = Application.Match(Range("Machines!Machine").Value, Range("t_Machines[Machine]"), 0)
  If Not IsError(Pos) Then
    Read "t_Machines", Pos, Map
  Else
    MsgBox "Cette machine n'existe pas", vbExclamation
  End If
End Sub
 
Sub SaveMachine()
  Dim Pos
  Dim Map
  Dim Answer As VbMsgBoxResult
 
  Pos = Application.Match(Range("Machines!Machine").Value, Range("t_Machines[Machine]"), 0)
  If IsError(Pos) Then
    Answer = MsgBox("Cette machine n'existe pas. Voulez-vous la créer?", vbQuestion + vbYesNo)
    If Answer = vbYes Then Pos = Range("t_Machines").ListObject.ListRows.Add.Index
  End If
  If Not IsError(Pos) Then
    Map = VBA.Array("Machines!Machine", "Machine", "Machines!Libelle", "Désignation", "Machines!Largeur", "Largeur (m)", "Machines!Longueur", "Longueur (m)")
    Save "t_Machines", Pos, Map
  End If
End Sub
 
Sub ReadContact()
  Dim Pos
  Dim Map
 
  Map = VBA.Array("Personnes!Code", "ID", "Personnes!Prenom", "Prénom", "Personnes!Nom", "Nom", "Personnes!DN", "DN", "Personnes!Service", "Service")
  Pos = Application.Match(Range("Personnes!Code").Value, Range("t_Contacts[ID]"), 0)
  If Not IsError(Pos) Then
    Read "t_Contacts", Pos, Map
  Else
    MsgBox "Ce contact n'existe pas", vbExclamation
  End If
End Sub

On pourrait encore pousser plus loin pour rendre le code encore plus générique, mais ce n'est utile qu'à partir d'un certain nombre de paire formulaire/Tableau, le but étant toujours de limiter la redondance du code. Dans l'exemple ci-dessus, on voit bien que les codes ReadMachine et ReadContact sont similaires à l'une ou l'autre donnée près. On pourrait donc paramétrer cela dans un tableau Excel pour simplifier encore le code et en sortir le "hard codind", notamment au niveau du mappage Cellules/Colonnes.