Moteur de recherche + Fonction modifier VBA-USERFORM

[Smaily]

Bonjour,

Je souhaite créer une sorte de moteur de recherche en VBA, cela dit je bloque un peu.
Le but de cette macro est de rechercher une ligne de la feuille "Répertoire" comportant la donnée recherchée. (une sorte de filtre)

Merci d'avance pour le coup de main.
Cordialement.

 

[Smaily]

Ah non c'est bon c'est réglé c'etait une erreur de plugin je regarde la macro...

 

[Smaily]

Tout marche nickel !!!!
Je présente mon projet demain en espérant que ça convienne.
Je tiens à te remercie de m'avoir aider, j'aurai pas su faire tout ça sans toi et mapomme !

Vous trouverez ci-joint la version finale.

Bonne continuation

 

[Smaily]

Afin de finaliser ce travail, on m'a demandé si c'était possible de créer un compteur permettant de connaitre le temps de présence de la marchandise. Ce qui reviendrait à faire : Date actuelle - Date de saisie. Est-ce possible ?

 

[Smaily]

J'ai finalement ajouté une formule : AUJOURD'HUI()-DATE. Cela a l'air de fonctionner.
Cependant comment fonctionnent les OptionButton avec le squelette de votre programme ?

 

[Dranreb]

Bonjour.
Déjà on voit qu'il n'ont pas été implantés par le GénérateurUFm sinon ils se seraient appelés OBnVide et OBnPlein.
J'ai prévu, mais je vais vérifier si ça fonctionne, de ne les traiter avec ControlsAssociés que via un petit Frame, appelons le FrmÉtat dans lequel ils doivent être logés et qu'on lui spécifie seul au Add
Apparemment il y a un souci…

 

[Dranreb]

Je renvoie le précurseur du CBxLCtlA.xlam parce qu'il y avait une erreur dans la gestion des OptionButton dans un Frame: j'ajoutais à une collection l'OptionButton au lieu de l'objet CassoOBn qui le supportait. À réinstaller donc. Il y aura peut être d'autres problèmes, ça n'a guère eu l'occasion d'être testé.

Il y a un autre problème: n'étant pas dans des colonnes supplémentaires séparées qu'on pourrait exclure de la partie mise à jour, la formule "Temps de présence" est effacée lors de l'écriture. Alors il faut la remettre:

Private Sub CBnValider_Click()
   CA.ValeursVers TVL
   TVL(1, 7) = "=TODAY()-[@Date]"
   If LCou = 0 Then
      CL.ValeursVers TVL
      CL.Lignes.Add.Range.Value = TVL
      CL.Actualiser
   Else
      CL.Lignes(LCou).Range.Value = TVL
      End If
   End Sub

Mais ça introduit un nouveau problème: il faut y mettre un format de nombre à 0 décimales, sinon format Standard, non ciblé, il le remplace par un format de date qui ne va pas.

 

[Smaily]

Il me semble avoir relevé toutes vos informations cependant le débogage ne se fait pas, il y a une erreur d'éxecution 459...
Désolé j'ai un peu de mal

 

[Dranreb]

Réinstallez le CBxLCtlA.xlam parce que là la référence CLsCAs cochée est celle du projet du CBxLCtlA.xlsm et comme il n'est pas IsAddin il se verra quand il s'ouvrira et il faudra le fermer manuellement.
Pour l'instant on ne peut pas ajouter d'OBn à un ControlsAssociés. On peut seulement ajouter un Frame qui en contient.
Au Add, l'objet ControlsAssociés fait l'nventaire des OptionButton qu'il contient, et pour lui la valeur du Frame est le Caption de celui qui est coché.

 

[Dranreb]

Bonjour.
Nouvelle version avec modification dans la gestion des boutons d'options contenus dans un cadre.
L'ancienne pouvait laisser le dernier utilisé dans un état indéfini quand aucun n'était coché.
Ouvrez le et laissez le se réinstaller en .xlam
À tout hasard je joins aussi votre classeur où ça a l'air de marcher. Mais continuez les tests.

 

[Smaily]

Bonjour,
Yes super ça fonctionne merci beaucoup!!!
Il ne manque plus qu'à optimiser le tableau de la Feuille 2 car je m’aperçois que ce dernier ne s'adaptable pas par rapport aux saisies de la feuille 1...
Avez-vous une rapide idée ?

 

[Dranreb]

J'utiliserais probablement un autre complément dont je joins le précurseur.

 

[Dranreb]

Pour peu qu'on coche aussi la référence Microsoft Scripting Runtime, il permettrait de faire fonctionner ce code dans le module Feuil3 (BILAN GRAPH) :

Option Explicit
Private Sub Worksheet_Activate()
   Dim Dico As Dictionary, Données As Collection, LOt As ListObject, _
      TTit(), TRés(), Réf As SsGr, Emp As SsGr, L As Long, C As Long
   Set Dico = DicInvent(Feuil1, 8, 2)
   Set Données = Gigogne(Null, 2, 8)
   Set LOt = Me.ListObjects(1)
   ReDim TTit(1 To 1, 1 To LOt.ListColumns.Count), _
      TRés(1 To LOt.ListRows.Count, 1 To LOt.ListColumns.Count)
   TTit(1, 1) = "Référence"
   VerserEntêtes TTit, Dico
   For Each Réf In Données
      L = L + 1
      TRés(L, 1) = Réf.Id
      For Each Emp In Réf.Co
         TRés(L, Dico(Emp.Id)) = Emp.Count
         Next Emp, Réf
   LOt.HeaderRowRange.Value = TTit
   LOt.DataBodyRange.Value = TRés
   End Sub

 

[Smaily]

ça marche bien reçu mais je constate un petit problème lors de l'exécution du programme :

 

[Dranreb]

Peut être le tableau n'est-il pas assez grand pour tout contenir ?
Essayez comme ça :

Option Explicit
Private Sub Worksheet_Activate()
   Dim Dico As Dictionary, Données As Collection, LOt As ListObject, _
      TTit(), TRés(), Réf As SsGr, Emp As SsGr, L As Long, C As Long
   Set Dico = DicInvent(Feuil1, 8, 2)
   Set Données = Gigogne(Null, 2, 8)
   Set LOt = Me.ListObjects(1)
   ReDim TTit(1 To 1, 1 To LOt.ListColumns.Count), _
      TRés(1 To LOt.ListRows.Count, 1 To LOt.ListColumns.Count)
   TTit(1, 1) = "Référence"
   VerserEntêtes TTit, Dico
   For Each Réf In Données
      L = L + 1: If L > UBound(TRés, 1) Then Exit For
      TRés(L, 1) = Réf.Id
      For Each Emp In Réf.Co
         C = Dico(Emp.Id)
         If C <= UBound(TRés, 2) Then TRés(L, C) = Emp.Count
         Next Emp, Réf
   LOt.HeaderRowRange.Value = TTit
   LOt.DataBodyRange.Value = TRés
   End Sub

 

[Smaily]

Yesssss tout fonctionne merci beaucoup pour toutes cette aide !!!
Bonne soirée