recherche et modification enregistrement

[jean marc1234]

bonjour,
j'ai actuellement un classeur avec plusieurs page qui chacune contienne un tableau avec des entêtes identiques.
Un userform unique me permet d'entrer des enregistrements dans la feuille que je souhaite.
Je recherche un code qui me permettrais par le même userform avec un bouton "rechercher" et par le champ "nom"de retrouver un enregistrement et de pouvoir enregistrer la modification éventuelle.
J'espère que je suis clair dans ma demande.
Voila si quelqu’un pouvais m'aider.
Merci d'avance

 

[jean marc1234]

oui
alors j'ai essayer d'effectuer des regroupements sur une seule feuille mais sa ne fonctionne pas
et je ne sais pourquoi à chaque tableau j'ai une ligne vierge qui vient se mettre entre la ligne d’Entête et la première ligne de données.Je me demande si se la ne vient pas de la.
J'ai essayer de manières différentes mais je bloque.

 

[jean marc1234]

pour info
le premier classeur que j'avais construit avec une seule feuille

 

[Dranreb]

Je vais écrire deux procédures dans un module standard, Synthèse et Éclatement qui feront la chose correctement, en utilisant les ListObject des tableaux.
Mais on ne pourrait pas utiliser les noms des feuilles et virer la colonne A des feuilles d'agences ?

 

[jean marc1234]

merci à vous
j'ai hâte de regarder cela

 

[Dranreb]

L'objet Worksheet représentant la première feuille d'agence ayant été renommée WshAg1, et celui de la feuille "synthèse" WshSynth, le code pour regrouper est actuellement le suivant :

Option Explicit

Sub Synthèse()
Dim LObSy As ListObject, PlgRés As Range, LMax As Long, _
    WshAg As Worksheet, LObAg As ListObject, PlgSrc As Range
Set LObSy = WshSynth.ListObjects(1)
Set PlgRés = LObSy.HeaderRowRange.Offset(1)
Set WshAg = WshAg1
Do: Set LObAg = WshAg.ListObjects(1)
   If LObAg.ListRows.Count = 0 Then
      Set PlgSrc = LObAg.HeaderRowRange.Offset(1)
   Else: Set PlgSrc = LObAg.DataBodyRange: End If
   PlgRés.Rows(LMax + 1).Resize(PlgSrc.Rows.Count).Value = PlgSrc.Value
   PlgRés(LMax + 1, 1).Resize(PlgSrc.Rows.Count).Value = UCase(WshAg.Name)
   LMax = LMax + PlgSrc.Rows.Count
   Set WshAg = WshAg.Next: Loop Until WshAg Is Nothing
If LObAg.ListRows.Count > LMax Then LObAg.ListRows(LMax + 1).Range _
   .Resize(LObAg.ListRows.Count - LMax).Delete xlShiftUp
End Sub

Remarque: il y avait des information qui avaient été ajoutées en dehors des tableaux de certaine agences, en dessous d'eux.

 

[Dranreb]

Celui de l'UserForm ?
Non, je ne crois pas. Pas si la feuille "synthèse" ne vous intéresse pas, en dehors de la mise à jour. Le mieux serait de la laisser dans un module standard de façon à pouvoir l'invoquer de n'importe où où l'on pourrait en avoir besoin.

 

[Dranreb]

Avec la procédure ÉclaterParAgence qui fait l'inverse :

Option Explicit

Sub Synthèse()
Dim LOtSy As ListObject, RngSy As Range, LMax As Long, _
    WshAg As Worksheet, LOtAg As ListObject, RngAg As Range
Set LOtSy = WshSynth.ListObjects(1)
Set RngSy = LOtSy.HeaderRowRange.Offset(1)
Set WshAg = WshAg1
Do: Set LOtAg = WshAg.ListObjects(1)
   If LOtAg.ListRows.Count = 0 Then
      Set RngAg = LOtAg.HeaderRowRange.Offset(1)
   Else: Set RngAg = LOtAg.DataBodyRange: End If
   RngSy.Rows(LMax + 1).Resize(RngAg.Rows.Count).Value = RngAg.Value
   RngSy(LMax + 1, 1).Resize(RngAg.Rows.Count).Value = UCase(WshAg.Name)
   LMax = LMax + RngAg.Rows.Count
   Set WshAg = WshAg.Next: Loop Until WshAg Is Nothing
SupprimerReste LOtAg, LMax
End Sub

Sub ÉclaterParAgences()
Dim TSy(), WshAg As Worksheet, Sujet, TNomAg(), TTLSy(), N As Long, _
    TLSy() As Long, LSy As Long, LAg As Long, C As Long, LOtAg As ListObject
TSy = WshSynth.ListObjects(1).DataBodyRange.Value
Set WshAg = WshAg1
Do: WshAg.Name = WshAg.CodeName: Set WshAg = WshAg.Next: Loop Until WshAg Is Nothing
Sujet = CBxL.SujetCBx(TSy): TNomAg = Sujet(0): TTLSy = Sujet(1)
Set WshAg = WshAg1
For N = 0 To UBound(TNomAg)
   If N > 0 Then Set WshAg = WshAg.Next: If WshAg Is Nothing Then _
      WshAg.Copy After:=WshAg: Set WshAg = WshAg.Next
   WshAg.Name = TNomAg(N): TLSy = TTLSy(N)
   ReDim TAg(1 To UBound(TLSy), 1 To 12)
   For LAg = 1 To UBound(TLSy)
      LSy = TLSy(LAg): For C = 1 To 12: TAg(LAg, C) = TSy(LSy, C): Next C, LAg
   Set LOtAg = WshAg.ListObjects(1)
   LOtAg.HeaderRowRange.Offset(1).Value = TAg
   SupprimerReste LOtAg, UBound(TAg, 1)
   Next N
End Sub

Private Sub SupprimerReste(ByVal LOt As ListObject, ByVal LMax As Long)
If LOt.ListRows.Count > LMax Then LOt.ListRows(LMax + 1).Range _
   .Resize(LOt.ListRows.Count - LMax).Delete xlShiftUp
End Sub

 

[Dranreb]

Toujours dans un module standard.
Testez les procédures pour vous assurer que tout est en ordre.

Après ça, maintenant, il serait souhaitable de se passer complètement des listes de la feuille "liste".
L'objet ComboBoxLiées fabrique en effet, pour les ComboBox dont on lui confie la charge, des listes classées et sans doublon pertinentes à partir du tableau à mettre à jour. L'inconvénient c'est que ce qui n'existe pas déjà dans la base doit être tapé au moins une première fois dans la ComboBox correspondante. Le complément CBxL.xlam comporte toutefois un dispositif permettant de d'ajouter des valeurs standard à un sujet, mais ça n'a jamais été utilisé et de plus ça pourrait laisser croire qu'une telle valeur est compatible, dans l'existant, avec les choix déjà faits.
Ce que j'ai dit au paragraphe précédent ne s'applique qu'aux ComboBox devant pouvoir faire l'objet d'une recherche. Il en manque me semble-t-il pour la date, le site, le nom et le numéro client.

 

[Dranreb]

Soit.
Mais je n'ai encore rien commencé sur l'UserForm, à part le renommer.
Donnez des noms mnémoniques aux objet, commençant par un trigramme CBx, TBx, CBn suivi d'un mot comment par une majuscule.

Pour ma part j'applique ces trigrammes là :

 

[Dranreb]

Travaillez un peu de votre coté: renommez les contrôles et mettez des ComboBox pour toutes les données devant pouvoir faire l'objet d'une recherche dans la base.

 

[Dranreb]

Non, c'est pas lisible, je trouve, tout en minuscules. Prenez les trigrammes que j'ai indiqué, voulez vous ? Et mettez des ComboBox pour le nom et le N°client, et peut être aussi la date, qu'on soit sûr que tout ça puisse aboutir à une ligne unique, si elle existe.
Après, ça commencera comme ça dans l'UserForm :

Option Explicit
Private WithEvents CL As ComboBoxLiées

Private Sub UserForm_Initialize()
Set CL = Création.ComboBoxLiées
CL.Plage WshSynth
CL.Add Me.CBxAgence, 1
CL.Add Me.… etc.
…
…
…
CL.CouleurSympa
CL.Actualiser
End Sub

 

[Dranreb]

Je vois toujours 'cbxagence' au lieu de 'CBxAgence' et pas d'autre ComboBox pour la recherche ?
Ah si, à droite j'avais pas vu. Parce que dans mon esprit elle devaient remplacer les TextBox. Pas besoin d'avoir plusieurs contrôles pour la même chose.
Mais les Label à gauche, c'est déjà mieux qu'au dessus.

 

[Dranreb]

Il y de fortes chances que si on saisi un nom existant sans spécifier l'agence ça suffit, non ?
J'avais avancé de mon coté. La CBxAgence existait déjà.

 

[Dranreb]

Choisissez après dans les autres ComboBox les informations manquantes pour aboutir à une seule ligne. Chaque choix restreint les listes des ComboBox qui n'ont pas encore fait l'objet de choix, jusqu'à tomber sur une ligne unique.

 

[Dranreb]

Affichez l'UserForm et faites des essais.