visual basic appliqué à access

**microman** · 21/05/2006, 21h27

Bonjour !

Je travaille actuellement à l'optimisation d'une base de donnée de gestion de nomenclatures.

Je souhaite réaliser une requête sous Access (via l'interface graphique des requêtes, le langage SQL, ou si possible via le langage VB), qui face l'inventaire de toutes les nomenclatures "filles" contenues dans une nomenclature "mère". J'ai déjà réfléchi au problème mais mes connaissances limitées en programmation me mènent à vous contacter.
Dans l'éventualité où vous pourriez m'aider, je me permets de vous présenter le contexte.

Je dispose d'une seule table "T1" contenant 3 champs :

Les 3 champs :
REF_1
REF_2
Type_de_REF_2

La colonne REF_1 contient toute les références de nomenclatures (et sous nomenclatures) recensées à la SEROP depuis des années.
La colonne REF_2 contient les sous références des nomenclatures REF_1
Ces sous références enregistrées dans le champs REF_2 sont elles mêmes des nomenclatures SI le champs Type_de_REF_2 vaut "1". Si le champs Type_de_REF_2 ne vaut pas "1", ces références (REF_2) correspondent à des composants et non à des nomenclatures.

La colonne REF_1 recense donc la totalité des références de nomenclatures "mère seule" ET "mère et fille".
En d'autre termes, toutes les REF_2 dont le champs Type_de_REF_2 = "1" figurent aussi dans la colonne REF_1.

Mon objectif est le suivant :
Je souhaite recenser dans une table, toutes les sous nomenclatures appartenant à une référence de nomenclature quelconque, saisie par l'utilisateur de la Base de données.

Plusieurs problèmes se posent à moi. Je souhaiterai que la recherche de sous nomenclatures fonctionne quelque soit la "profondeur" de l'arborescence. D'où la nécessité probable de réaliser un bouclage de la procédure de recherche de sous nomenclatures. De plus je suppose utile de créer soit une table temporaire, soit un tableau dynamique, pour stocker les références de sous nomenclatures de niveau "n", pendant l'exploration de chacune d'elles. Je ne m'exprime peut être pas très clairement mais l'objectif principal est celui décrit ci-dessus.

Je vous remercie pour tout type d'aide que vous pourriez m'apporter.

P.S : Toutes les références sont au format "alphanumérique" et sont peu voire pas du tout "normalisées".
Jai créée une requête1 qui sélectionne toutes les références REF_2 contenues dans la référence REF_1.
Le résultat fait apparaître les sous références, et leur type : type_de_ref_2, qui vaut "1" si ces références sont elles-même mères. Il faudrait ré exécuter la requête sur chacune des sous références mères trouvées jusqu'à n'avoir plus que des Type_de_ref_2 différents de "1", et recenser toutes les références de type "nomenclatures" parcourues.

**Heureux-oli** · 21/05/2006, 22h26

Ceq ue tu veux n'est pas vraiment très clair. Mais ce que tu voudrait c'est une sorte d'arborescence ou pour une nomenclature pricipale, tu aie tous ses fils.

J'ai vu qu'il y a des 1, 2 ou trois dan sle troisième champ, à quoi correspondent exactement ces valeurs.

Ce qui est bizzare dans ton explication, c'est que ce sont les champs2 qui deviennent de niveau 1.

**Heureux-oli** · 21/05/2006, 22h41

Regarde si c'est ça que tu veux.

**microman** · 21/05/2006, 23h04

je regarde ce que tu m'a fais...

Le type "1" signifie que le REF_2 correspondant contient lui même une (ou plusieurs) sous référence(s).

Si le type vaut autre chose que "1" le REF_2 correspondant ne contient aucune sous référence.

Plus précisément et à titre d'information : "1" signifie que la ref correspondante est une nomenclature (donc elle contient forcément des sous référence), "2" signifie que la reférence correspondante est une pièce fabriquée. et "3" une référence de pièce achetée.

C'est bel et bien une arborescence que je veux "extraire" de la table T1.

**philben** · 22/05/2006, 00h50

Bonjour,

ci-joint un formulaire access qui peut faire l'affaire... Ce n'est pas une simple requête mais du VBA...

Formulaire à importer dans votre base access T1.mdb.

Philippe

**philben** · 22/05/2006, 00h55

Oups, j'ai oublié la pièce-jointe...

**microman** · 22/05/2006, 08h13

Bonjour Philippe, et merci pour votre aide !

Malheureusement je n'ai que Access 97, je ne peux donc pas lire votre formulaire...
Si vous pouviez me le convertir ça m'aiderai beaucoup !

Bonne journée

C'est bon je l'ai converti et je pense que ça marche ! Reste à vérifier quelques trucs... Pour certaines références, j'ai un message d'erreur : voir le fichier joint !

**philben** · 22/05/2006, 09h56

ci-joint la version 97.

**microman** · 22/05/2006, 10h39

Merci Philippe, j'espère pouvoir te remercier pour ta précieuse aide.

Je n'ai pas encore compris la raison du message d'erreur qui apparait pour certaine références... je continue à chercher.

Qu'est ce qu'il faudrait modifier pour que la liste2 ne fasse apparaître que les sous références "mères" et pas celles dont le type est différent de "1" ?

J'ai essayé de commenter le code, voir le fichier joint. Il y a peu être des énormités...

**philben** · 22/05/2006, 10h58

Le msg d'erreur vient surement d'un dépassement de capacité de rowsource de liste2 (je n'ai pas eu le problème avec access 2003).

Solutions : limiter la longueur à 2000 octets puis passer le reste sur une autre liste, ou sauvegarde dans table puis afficher dans sous-formulaire,...

La requete de la liste des nomenclature dans le nouveau fichier joint n'a plus la condition where initiale qui n'était pas bonne à mon avis.

Le formulaire est brut de fonderie, il faut l'affiner, ajouter un gestionnaire d'erreur, etc, mais le principe est là.

Bon courage.

**microman** · 22/05/2006, 11h02

Ok, merci pour les conseils. Pour l'instant je ne sais pas faire ça (gestion d'erreurs, de tables temporaires...) mais je vais essayer !

**philben** · 22/05/2006, 11h11

Pour ne conserver que les type_ref_2 = 1, rajouter dans la clause where de oRs :

Code :

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

1
2
3
 
 
... AND TYPE_REF_2=1

A tester...

**microman** · 22/05/2006, 11h22

La condition supplémentaire type_ref_2 = 1 fontionne et je n'ai plus de message d'erreur ! Hallelujah !

Mais bon c'est peu être pas fini !

En effet ! Quand j'ajoute la condition TYPE_REF_2=1 dans la requete WHERE, le compteur Me.prof ne fonctionne plus et me renvoi la valeur de Me.nb+1...

**philben** · 22/05/2006, 12h26

Voici le code final du formulaire :

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
 
 
Private Sub Liste0_Click()
    Dim oDB As DAO.Database
    Set oDB = CurrentDb()
    Me.Liste2.RowSource = vbNullString
    Me.prof = 0
    Me.nb = 0
    Me.Repaint
    DoCmd.Hourglass True
    If Not IsNull(Me.Liste0.Value) Then
        AutoCall oDB, Me.Liste0.Value
    End If
    Me.nb = Me.Liste2.ListCount
    DoCmd.Hourglass False
    Me.Repaint
    Set oDB = Nothing
End Sub
Private Sub AutoCall(oDB As DAO.Database, sRef As String)
    Dim oRs As DAO.Recordset
 
    Set oRs = oDB.OpenRecordset("SELECT REF_2, TYPE_REF_2 FROM T1 WHERE (((REF_1)='" & sRef & "') AND ((REF_1)<>(REF_2)) AND ((TYPE_REF_2)=1))", dbOpenSnapshot)
    Me.prof = Me.prof + 1
 
    Do Until oRs.EOF = True
        Me.Liste2.RowSource = Me.Liste2.RowSource & oRs.Fields("REF_2") & ";"
        AutoCall oDB, oRs.Fields("REF_2")
        oRs.MoveNext
    Loop
 
    Set oRs = Nothing
End Sub

C'est bon je pense...

**microman** · 22/05/2006, 13h39

Bizarre le problème d'incrémentation du compteur de "profondeur" continue...
Je continue de chercher !

Qu'est ce que je peux faire pour vérifier pas à pas le fonctionnement du code ? (Insertion de Msgbox sur Me.prof et REF_2 ?)

Modification du message
Je n'ai pas encore trouvé comment faire pour régler le problème du compteur... Mais maintenant que le principe fonctionne (merci Philippe), je souhaiterai copier les enregistrements qui apparaissent dans la liste de résultats, dans une nouvelle table (qui sera elle-même liée à une table "PRIX"). J'ai donc besoin d'écrire en VBAccess le code qui convient, donc si pendant que je m'arrache les cheveux, un surdoué du clavier a la solution en tête... je prends !

Modif message
J'ai trouvé ça pour la création de la table, maintenant je dois trouver comment la remplir avec les résultats trouvés avant !

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
Sub CreerTable()
Dim oDb As DAO.Database
Dim oNouvelleTable As DAO.TableDef
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
'Instancie la base de données
    Set oDb = CurrentDb
'Crée la nouvelle table
    Set oNouvelleTable = oDb.CreateTableDef("SousNomenclatures")
'Crée le champ SousNom
    Set oChamp = oNouvelleTable.CreateField("SousNom", dbLong)
'Ajoute le champ à la table
    oNouvelleTable.Fields.Append oChamp
'Ajoute la table à la base de données
    oDb.TableDefs.Append oNouvelleTable
'Libère les variables
oDb.Close
Set oChamp = Nothing
Set oNouvelleTable = Nothing
Set oDb = Nothing
End Sub

Modif message
Je pense que je dois utiliser le contenu de

Code :

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

Me.Liste2.RowSource = Me.Liste2.RowSource & oRs.Fields("REF_2") & ";"

et réussir à le copier dans ma table...
Finalement non, je pense que je devrai enregistrer les résultats trouvés dans ma table à chaque Loop, donc pas besoin d'utiliser Me.Liste2.RowSource =.... A voir.

Modif message
Pour l'instant j'en suis là mais ça ne fonctionne pas (pas d'enregistrements n'apparaissent dans la table de résultat (qui elle se créée bien !)

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
Private Sub EnregistrerResultats()
'enregistrement dans la table sous nomenclature
'on sélectionne tous les éléments de la table SousNomenclature et on les ouvre en mode lecture et écriture
Set oRs = oDb.OpenRecordset("SELECT * FROM [SousNomenclatures]", dbOpenDynaset)
'on vérifie si la table contient des enregistrements
If (oRs.RecordCount <> 0) Then
    'on va se placer au denier enregistrement
    oRs.MoveLast
    'on passe la table en mode ajout
    oRs.AddNew
    'là on ajoute le nouvel enregistrement
    oRs.Fields("SousNom").Value = Me.Liste2.RowSource
    oRs.Update
End If
oRs.Close
End Sub

Modif message
Bien que je n'ai pas résolu les problèmes ci-dessus je progresse pas à pas, et j'y prend goût !
Un de mes nouveaux problèmes actuel est de vérifier que la table que je créer n'existe pas déjà : pour l'instant j'ai un message d'erreur qui s'affiche me disant que ma table existe déjà.
Que écrire...(?)

Code :

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

1
2
3
If table = ... then
Else ...
End if

**philben** · 22/05/2006, 23h29

Re Bonjour,

A) Profondeur de recherche
j'avais en faite appelé <profondeur de recherche> le nombre d'appel de la fonction AutoCall.
Voir le code ci-dessous pour avoir réellement la profondeur de recherche

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
42
43
44
45
46
47
48
49
50
 
 
Private Sub Liste0_Click()
    Dim oDB As DAO.Database
 
    Set oDB = CurrentDb()
 
    Me.Liste2.RowSource = vbNullString
    Me.prof = 0
    Me.nb = 0
    Me.Repaint
 
    DoCmd.Hourglass True
 
    If Not IsNull(Me.Liste0.Value) Then
      AutoCall oDB, Me.Liste0.Value, 0
    End If
 
    Me.nb = Me.Liste2.ListCount
    DoCmd.Hourglass False
    Me.Repaint
 
    Set oDB = Nothing
End Sub
 
Private Sub AutoCall(oDB As DAO.Database, sRef As String, iNiveau As Integer)
    Static siMaxNiveau As Integer
    Dim oRs As DAO.Recordset
    Dim sSql As String
 
    If iNiveau = 0 Then
      siMaxNiveau = 0
    ElseIf iNiveau > siMaxNiveau Then
      siMaxNiveau = iNiveau
    End If
 
    sSql = "SELECT REF_2 FROM T1 WHERE (((REF_1)=""" & sRef & """) " & _
           "AND ((REF_1)<>(REF_2)) AND ((TYPE_REF_2)=1))"
    Set oRs = oDB.OpenRecordset(sSql, dbOpenSnapshot)
 
 
    Do Until oRs.EOF = True
        Me.Liste2.RowSource = Me.Liste2.RowSource & oRs.Fields(0) & ";"
        AutoCall oDB, oRs.Fields(0), iNiveau + 1
        oRs.MoveNext
    Loop
 
    If iNiveau = 0 Then Me.prof = siMaxNiveau
    Set oRs = Nothing
End Sub

B) Statistiques
Pour info, la nomenclature <059-063> contient 2 records :

La profondeur de niveau : 4
Le nombre de sous-références : 93

C) Table SousNomenclatures

Le champ "SousNom" ne doit pas être de type dbLong mais de type dbText si tu veux y coller le nom des sous-références
Si tu veux coller toutes les sous-références affichées d'une nomenclature dans cette table, voici la procédure :
- Créer la table à la main ou par VBA
- Sur le formulaire, créer un bouton
- Ecrire le code suivant sur l'évènement <sur click> du bouton

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
 
 
Private Sub XXX_Click()
Dim oDB As DAO.Database
   Dim oRs As DAO.Recordset
   Dim i As Integer
 
   Set oDB = CurrentDb()
   Set oRs = oDB.OpenRecordset("SousNomenclatures", dbOpenTable)
 
   For i = 0 To Me.Liste2.ListCount - 1
      If Len(Me.Liste2.ItemData(i)) > 0 Then
         oRs.AddNew
         oRs.Fields("SousNom").Value = Me.Liste2.ItemData(i)
         oRs.Update
      End If
   Next i
   MsgBox "Création de " & Me.Liste2.ListCount & " enregistrement(s)"
   Set oRs = Nothing
   Set oDB = Nothing
End Sub

Si vous souhaitez mettre dans cette table toutes les sous-refs de toutes les nomenclatures, il suffit de faire une boucle sur les nomenclatures et d'enregistrer dans la table les sous-refs qui sortent en mettant une barrière pour éviter les doublons.

Bon courage pour la suite !

**microman** · 22/05/2006, 23h56

Bonsoir Philippe, tes réponses de qualité m'encouragent à poursuivre mon apprentissage à la programmation et je t'en remercie. Ma fibre initiale étant la mécanique théorique, je t'invite à solliciter mes compétences si besoin était !

Je vais analyser ce que tu me proposes dans ton dernier message et m'empresser d'insérer le code au formulaire. Suite à tes recommandations, j'ai trouvé des exemples de gestionnaires d'erreurs, je m'y attarderai un peu plus tard.
Julien

Modif message
Voilà qui est fait : tout fonctionne très bien ! Il me reste à gérer l'effacement automatique de la table à chaque ré exécution de la recherche de sous nomenclatures. Je vais aussi essayer d'ajouter une 2ième liste affichant les nomenclatures mères des sous nomenclatures trouvées. Pour ça je pense qu'il faut que je fasse une requête SQL imbriquée dans le code VB (comme tu l'as fait pour la recherche des sous nomenclatures), mais cette fois ci à l'envers. C'est à dire en cherchant le REF_1 de chaque niveau.
Merci beaucoup.

Modif message
Pour l'effacement automatique de la table c'est fait. J'ai adapté un code trouvé sur internet, dont voici le résultat. Ce n'est peut être pas parfait mais ça fonctionne. Question : Pourquoi utiliser une "fonction" plutôt qu'une "procédure" ou l'inverse ? A quoi sert le dbOpenDynaset ?

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
Function fnSupprimerDonneesTable()
On Error GoTo Err_Handler

Dim oDb As DAO.Database
Dim oRs As DAO.Recordset

Set oDb = CurrentDb
'On sélectionne tous les éléments de la table "SousNomenclatures" et on les ouvre en mode lecture et écriture
Set oRs = oDb.OpenRecordset("SELECT * FROM [SousNomenclatures]", dbOpenDynaset) 'à quoi sert dbOpenDynaset ?

If (oRs.RecordCount <> 0) Then
oRs.MoveLast
While Not oRs.BOF
'On va ici supprimer la dernière ligne de la table "SousNomenclatures"
oRs.Delete
'Puis on passe à la ligne précédente
oRs.MovePrevious
Wend
End If

oRs.Close
Exit_Fn:
'On libère les variables
Set oDb = Nothing
Set oRs = Nothing
Exit Function
Err_Handler:
'En cas d’erreur, affichage du message d’erreur avec le numéro d’erreur
Call MsgBox(Err.Number & " " & Err.Description, vbCritical)
Resume Exit_Fn
End Function

**microman** · 23/05/2006, 09h56

Voici où j'en suis ! Voir la pièce jointe (63ko)
J'ai fortement réduit la taille de la table T1 pour diminuer la taille de la pièce jointe (il reste 2999 enregistrements contrairement aux 100 000 initiaux).
Exemple de référence intéressante à tester : 026-035.
Puis (par exemple) double click sur 026-035-40
Puis (par exemple) double click sur 026-035-40-090
...
On constate que la gestion de profondeur de sous nomenclatures fonctionne bien !
Et qu'à chaque ouverture d'une sous nomenclature, les anciens enregistrements de la table SousNomenclature sont effacés, et les nouveaux y sont enregistrés.

**Tofalu** · 23/05/2006, 10h25

C'est cool les échanges de fichiers, mais quel est le but pour les autres visiteurs.

Developpez.com, ne peut certifier que ces fichiers sont sûrs, il se peut que l'auteur y glisse des opérations dangereuses exécutées en VBA. Dés lors, peu de personnes télechargent le fichier, du coup, personne ne peut vous aider.

Préferez des explications plutot que tu partage de fichiers inutile pour la communauté

**philben** · 23/05/2006, 20h16

Mes humbles félicitations microman (ou AccessMan ?) pour ton code VBA, en quelques jours les progrès sont flagrants !

Bonne continuation,

Philippe

http://kappa.chez-alice.fr/

visual basic appliqué à access

VBA Access

Discussions similaires

Partager

Partager