Application:bibliothèque

Private Sub Form_Delete(Cancel As Integer)
' procédure déclenchée lorsqu'un enregistrement est supprimé
End Sub

Private Sub Form_Open(Cancel As Integer)
' procédure déclenchée lorsque le formulaire s'ouvre
End Sub

Private Sub Quantite_AfterUpdate()
'procédure déclenchée lorsque le contrôle "Quantite" a été mis à jour
End Sub

Dim une_variable As type

'en-tête du module
Option Compare Database
Option Explicit
Dim une_variable As Integer

'procédure du bouton nommé BoutonDVP1
Private Sub BoutonDVP1_Click()
 une_variable = 1
End Sub
'procédure du bouton nommé BoutonDVP2
Private Sub BoutonDVP2_Click()
 Debug.Print une_variable
End Sub

'commentaire générique
'La majorité des fonctions ci-dessous utilisent ADO, le processus d'accès à la bd sera toujours comme suit
' rst.open ...-> pour les requêtes de type SELECT
' db.execute ...-> pour les ordres DML, c'est à dire update, insert et delete
'Dans ce module, nous utiliserons DAO uniquement pour récupérer des informations sur le DDL
'Directives MSAccess
Option Compare Database
Option Explicit


Dim dbDAO As Database 'Variable globale au module connexion db en DAO
Dim db As New ADODB.Connection 'Variable globale au module connexion db en ADO
Dim rst As New ADODB.Recordset 'Variable globale au module recordset ADO

'Cette fonction est appelée pour initialiser DAO
Private Function initDAO() As Boolean
On Error GoTo err

Set dbDAO = CurrentDb

initDAO = True
Exit Function

err:
    MsgBox err.Number, err.Description
    initDAO = False
    
End Function

'Cette fonction est appelée pour initialiser ADO
Private Function initADO() As Boolean
On Error GoTo err
If db.State <> adStateClosed Then db.Close
If rst.State <> adStateClosed Then rst.Close
Set db = CurrentProject.Connection

initADO = True
Exit Function

err:
    MsgBox err.Number, err.Description
    initADO = False
    
End Function

'Cette fonction ferme les ressources allouées à ADO, db et recordset
Private Function closeADO() As Boolean
If db.State <> adStateClosed Then db.Close
If rst.State <> adStateClosed Then rst.Close
End Function

'Cette fonction est appelée lors de l'ajout d'un nouvel et renvoie "vrai" si 
'un auteur avec le même nom et prénom que ceux passés en paramètre existe déjà.
'c'est juste un avertissement pour éviter des erreurs de distraction de la part des utilisateurs
Public Function verification_auteur(nomAuteur As String, prenomAuteur As String) As Boolean
Dim ado As Boolean
On Error GoTo err
If Not initADO() Then
    MsgBox "Problème d'initialisation ADO", vbCritical
    Exit Function
End If

rst.Open "select count(*) as cnt from auteurs where nom_auteur='" & nomAuteur & "' and prenom_auteur='" & _
          prenomAuteur & "'", db

If rst("cnt") > 0 Then
    verification_auteur = True
Else
    verification_auteur = False
End If

ado = closeADO()

Exit Function

err:
    MsgBox err.Number, err.Description
    
End Function

'Cette fonction est appelée lors de la réservation d'un livre. Elle vérifie que la quantité en stock est suffisante par
'rapport à la quantité que l'utilisateur souhaite réserver.
Public Function verification_livre(IDLivre As Long, Quantite As Integer) As Boolean
Dim ado As Boolean
On Error GoTo err

If Not initADO() Then
    MsgBox "Problème d'initialisation ADO", vbCritical
    Exit Function
End If
rst.Open "select Quantite_Stock from livres where ID_Livre='" & IDLivre & "'", db
If ((rst("Quantite_Stock") - Quantite) < 0) Then
    verification_livre = False
Else
    verification_livre = True
End If

ado = closeADO()
Exit Function
err:
    MsgBox err.Number, err.Description
    verification_livre = False
End Function

'Cette fonction est appelée lors d'une remise, elle vérifie que la quantité que l'utilisateur décide de remettre
'est bien inférieure ou égale à la quantité réservée
Public Function Verification_Reservation(IDRes As Integer, IDLigne As Integer, Qte As Integer)
Dim ado As Boolean
On Error GoTo err

If Not initADO() Then
    MsgBox "Problème d'initialisation ADO", vbCritical
    Exit Function
End If
rst.Open "select Quantite_Reservee from Reservation_Lignes where ID_Reservation=" & IDRes & " and ID_Ligne=" & _
         IDLigne, db
If ((rst("Quantite_Reservee") - Qte) < 0) Then
    Verification_Reservation = False
Else
    Verification_Reservation = True
End If

ado = closeADO()
Exit Function
err:
    MsgBox err.Number, err.Description
    ado = closeADO()
    Verification_Reservation = False
End Function

'Cette fonction sert à inter-changer les numéros d'affichage des onglets.
'Si par exemple vous aviez l'onglet "Réservations" en position 1 et l'onglet "Remises" en position 2 et que vous décidez
'd'afficher les remises en 1, l'appel à switch ordre sera comme ceci: retour=SwitchOrdre(1,2)
Public Function SwitchOrdre(ordre As Integer, OrdreOld As Integer) As Boolean
On Error GoTo err
Dim ado as Boolean

If Not initADO() Then
    MsgBox "Problème d'initialisation ADO", vbCritical
    Exit Function
End If
rst.Open "select count(*) as cnt from Ordre_Onglets where ordre in (" & ordre & "," & OrdreOld & ")", db

If (rst!cnt < 2) Then
 SwitchOrdre = False
 ado = closeADO()
 Exit Function
End If
rst.Close
rst.Open "select * from Ordre_Onglets where ordre in (" & ordre & "," & OrdreOld & ")", db, adOpenDynamic, adLockOptimistic
While Not rst.EOF
 If rst!ordre = ordre Then
  rst!ordre = OrdreOld
 Else
  rst!ordre = ordre
 End If
 rst.Update
 rst.MoveNext
Wend

ado = closeADO()
SwitchOrdre = True
Exit Function
err:
    MsgBox err.Number, err.Description
    ado = closeADO()	
    SwitchOrdre = False
End Function

'Cette fonction vérifie si une remise est liée à la réservation que l'utilisateur tente d'annuler
'nous n'appelons pas initAdo ni ADOclose car RemiseOk est appelée par une autre fonction gérant elle-même ces appels.
Function RemiseOk(IDReservation As Long) As Boolean
rst.Open "select count(*) as cnt from Remise_Entete where id_reservation=" & IDReservation, db
If rst!cnt = 0 Then
    RemiseOk = True
Else
    RemiseOk = False
End If
rst.Close

End Function

'Cette fonction vérifie que la date de remise est >= à la date de réservation
Public Function Verification_Date_Remise(IDReservation As Integer, RemDate As Date) As Boolean
On Error GoTo err
Dim ado As Boolean

If Not initADO() Then
    MsgBox "Problème d'initialisation ADO", vbCritical
    Exit Function
End If
rst.Open "select Date_Reservation from Reservations_entete where ID_Reservation=" & IDReservation, db
If rst!Date_Reservation > RemDate Then
 Verification_Date_Remise = False
 ado = closeADO()
 Exit Function
End If
Verification_Date_Remise = True
Exit Function
err: MsgBox err.Number, err.Description
     ado = closeADO() 			
End Function

'Cette fonction récupère le nom de toutes les tables existant dans la bd.
Public Function getTables() As Boolean
On Error GoTo err
Dim td As TableDef

If Not initDAO() Then
 MsgBox "Problème d'initialisation de DAO", vbCritical
 getTables = False
 Exit Function
End If
'On désactive les messages d'avertissement d'access
DoCmd.SetWarnings False
DoCmd.RunSQL ("delete from tmp_tables")
' On récupère toutes les tables non système et non temporaire
For Each td In dbDAO.TableDefs 
  If Left(td.Name, 4) <> "MSys" And Left(td.Name, 3) <> "tmp" Then
   DoCmd.RunSQL "insert into tmp_tables(table_name) values('" & td.Name & "')"
  End If
Next td
'On réactive les messages d'avertissement d'access
DoCmd.SetWarnings True
dbDAO.Close
getTables = True
Exit Function
err: MsgBox err.Number, err.Description
     DoCmd.SetWarnings True
     getTables = False
End Function

'Cette fonction récupère toutes les colonnes formant la structure de la table "tabname" donnée en paramètre
Public Function getColumns(tabname As String) As Boolean
On Error GoTo err
Dim col

If Not initDAO() Then
 MsgBox "Problème d'initialisation de DAO", vbCritical
 getColumns = False
 Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL ("delete from tmp_columns")

For Each col In dbDAO.TableDefs(tabname).Fields
 DoCmd.RunSQL "insert into tmp_columns(column_name) values('" & col.Name & "')"
Next col
getColumns = True
dbDAO.Close
Exit Function
err: MsgBox err.Number, err.Description
     DoCmd.SetWarnings True
     dbDAO.Close
     getColumns = False
End Function

'Cette fonction retourne le type de la colonne "colName" de la table "tabname"
Public Function getColumnType(tabname As String, colName As String) As Integer
On Error GoTo err
Dim col

If Not initDAO() Then
 MsgBox "Problème d'initialisation de DAO", vbCritical
 getColumnType = -1
 Exit Function
End If

Set col = dbDAO.TableDefs(tabname).Fields(colName)

getColumnType = col.Type
dbDAO.Close
Exit Function
err: MsgBox err.Number, err.Description
     DoCmd.SetWarnings True
     dbDAO.Close
     getColumnType = -1
End Function

'Cette fonction s'occupe de la mise à jour du stock. Elle gère:
'- la confirmation des réservations
'- l'annulation des réservations
'- la confirmation des remises

Public Function MAJ_Stock(IDReservation As Long, TypeMAJ As Integer) As Boolean
On Error GoTo err

Dim IDRemise As Integer
Dim RemComplete As Boolean
Dim ado As Boolean


If Not initADO() Then
    MsgBox "Problème d'initialisation ADO", vbCritical
    Exit Function
End If

If (TypeMAJ = 2) Then
 If Not RemiseOk(IDReservation) Then
  MsgBox "Vous ne pouvez plus annuler cette réservation car une remise est déjà en cours pour celle-ci", vbCritical
  Exit Function
 End If
End If

If TypeMAJ <> 3 Then
 rst.Open "select id_reservation, id_ligne,quantite_stock,quantite_reservee from livres inner join reservation_lignes" _
          & " on livres.id_livre = reservation_Lignes.id_livre where reservation_lignes.Id_Reservation =" & _
          IDReservation, db, adOpenDynamic, adLockOptimistic
 While Not rst.EOF
      Select Case TypeMAJ
        Case 1: 'Il s'agit d'une confirmation de réservation, donc on décrémente la qté en stock
            rst!Quantite_Stock = rst!Quantite_Stock - rst!Quantite_Reservee
'annulation de rés. donc on incrémente la quantité en stock car elle a déjà été déduite lors de la 
'confirmation de la réservation
        Case 2: 
            rst!Quantite_Stock = rst!Quantite_Stock + rst!Quantite_Reservee
      End Select
      rst.Update
      rst.MoveNext
 Wend
Else
'il s'agit d'une remise que l'on considère complète par défaut
 RemComplete = True
' ce recordset va permettre de déterminer si tous les livres ont été remis
 rst.Open "SELECT [Reservation_Lignes].[Quantite_Reservee], sum( [Remises_Lignes].[Quantite]) AS QuantiteRemise " _ 
          & "FROM Reservation_Lignes INNER JOIN Remises_Lignes ON [Reservation_Lignes].[ID_Ligne]=" _
          & "[Remises_Lignes].[ID_Reservation_Ligne] GROUP BY [Reservation_Lignes].[ID_Ligne], " _
          & "[Reservation_Lignes].[Quantite_Reservee]", db
 While Not rst.EOF
    If rst!QuantiteRemise > rst!Quantite_Reservee Then
     MsgBox "La quantité remise ne peut être supérieure à la quantité réservée", vbCritical
     ado = closeADO()
     MAJ_Stock = False
     Exit Function
    End If
    
    If rst!QuantiteRemise < rst!Quantite_Reservee Then
     RemComplete = False
    End If
  rst.MoveNext
 Wend
 rst.Close

 If Not RemComplete Then
  MsgBox "La remise est incomplète, veuillez la compléter! Si certains livres ont pas été remis, " _
         & "veuillez sélectionner non rendu comme état", vbCritical
  ado = closeADO()
  MAJ_Stock = False
  Exit Function
 End If
 'Ce recordset dynamique va nous permettre d'incrémenter la quantité en stock du livre remis, les jointures sont nécessaires
 ' pour assurer la cohérence des données
 rst.Open "SELECT remises_lignes.ID_Remise,remises_lignes.etat,reservation_lignes.ID_livre, remises_lignes.Quantite, " _
          & "Livres.Quantite_Stock, Reservations_entete.Id_Client FROM Reservations_entete INNER JOIN " _
          & "((Livres INNER JOIN reservation_lignes ON Livres.ID_Livre = reservation_lignes.ID_livre) INNER JOIN " _
          & "remises_lignes ON reservation_lignes.ID_Ligne = remises_lignes.ID_Reservation_Ligne) ON " _
          & "Reservations_entete.Id_Reservation = reservation_lignes.ID_Reservation WHERE " _
          & "remises_lignes.ID_Reservation_Ligne In (select ID_Ligne from Reservation_Lignes where ID_Reservation=" & _
          IDReservation & ") ORDER BY  remises_lignes.Etat", db, adOpenDynamic, adLockOptimistic
 IDRemise = rst!ID_Remise

 While Not rst.EOF 
  If rst!Etat = 1 Then
   rst!Quantite_Stock = rst!Quantite_Stock + rst!Quantite
   rst.Update
  End If
  rst.MoveNext
 Wend
 'On définit la remise comme clôturée
 db.Execute "update remise_entete set cloturee=true where ID_Remise=" & IDRemise
 'On définit la réservation comme clôturée
 db.Execute "update Reservations_entete set cloturee=true where ID_Reservation=" & IDReservation 
End If
If TypeMAJ = 1 Then 'si il s'agit d'une confirmation de réservation, on marque la rés. comme confirmée
    db.Execute "update reservations_entete set MAJ=true where id_reservation=" & IDReservation
ElseIf TypeMAJ = 2 Then 
's'il s'agit d'une annulation, on la supprime, pas besoin de supprimer les lignes car access le fera automatiquement
'grâce à la relation sur ID_Reservation entre les entêtes et les lignes.
    db.Execute "delete from reservations_entete where id_reservation=" & IDReservation
End If
ado = closeADO
MAJ_Stock = True
Exit Function
err:
    MsgBox err.Number, err.Description
    ado = closeADO
    MAJ_Stock = False
End Function

Private Sub Afficher_Click()
Dim ctl As TreeView, clients As DAO.Recordset, db As DAO.Database
Dim prbar As ProgressBar
Dim res As DAO.Recordset, remise As DAO.Recordset
Dim k As Integer, i As Integer, j As Integer

Set db = CurrentDb
Set prbar = Me!prog.Object

prbar.Min = 0
Set clients = db.OpenRecordset("select count(*) as n from Clients")
If clients!N <> 0 Then prbar.Max = clients!N
clients.Close

Set ctl = Me!tree.Object
'Recordset contenant les enregistrements de la table clients
Set clients = db.OpenRecordset("select  ID_Client, Nom_Client, Prenom_Client from Clients")
i = 1
j = 1
k = 1
'On parcours la table des clients qui est la table maître du treeview
While Not clients.EOF
 'on ajoute le noeud de 1er niveau, c'est à dire le client lui-même
 'la clé est la chaîne de caractère cli suivie de l'ID du client
 'le texte affiché est la concaténation du nom et du prénom
    ctl.Nodes.Add , , "cli" & clients!ID_Client, clients!Nom_Client & " " & clients!Prenom_Client
    'on ajoute un fils au client, ce fils c'est le noeud des réservations
    ctl.Nodes.Add "cli" & clients!ID_Client, tvwChild, "res" & i, "Réservations"
    'on ajoute un autre fils au client, le noeud des remises
    ctl.Nodes.Add "cli" & clients!ID_Client, tvwChild, "rem" & i, "Remises"
    ctl.Nodes("res" & i).BackColor = 16744448
    ctl.Nodes("rem" & i).BackColor = 8421631
    'On va chercher les infos qui nous intéresse dans les réservations du client
    'on a besoin de la jointure avec les tables livres et lignes réservations pour récupérer
    'le titre du livre ainsi que la quantité réservée
    Set res = db.OpenRecordset("SELECT Reservation_Lignes.ID_Reservation, Livres.Titre_livre, " _
    & "Reservation_Lignes.Quantite_Reservee,Reservations_entete.Id_Client FROM Reservations_entete" _
    & "INNER JOIN (Livres INNER JOIN Reservation_Lignes ON Livres.ID_Livre = " _
    & "Reservation_Lignes.ID_livre) ON Reservations_entete.Id_Reservation = Reservation_Lignes.ID_Reservation WHERE " _
    & "Reservations_entete.Id_Client=" & clients!ID_Client & " and Reservations_entete.MAJ=true")
    While Not res.EOF
    'On ajoute la ligne de réservation comme fils du noeud "réservation" qui est lui-même fils du noeud "client..."
    'Vous noterez que pour chaque noeud, la clé change. Je me sers des variables i,j,k qui sont assignées à chaque
    'type de noeud et incrémentées dès lors qu'un noeud leur correspondant est ajouté
     ctl.Nodes.Add "res" & i, tvwChild, "lres" & j, "N°" & res!ID_Reservation & _
     "Livre:" & res!Titre_livre & " Qté:" & res!Quantite_Reservee
     res.MoveNext
     j = j + 1
    Wend
    res.Close
    
    'On va chercher les infos qui nous intéresse dans les remises du client
    'le principe est exactement le même que pour le noeud des réservations.
    Set remise = db.OpenRecordset("SELECT Remises_Lignes.ID_Remise, Livres.Titre_livre, Remises_Lignes.Quantite, " _
    & "Reservations_entete.Id_Reservation FROM Remise_Entete INNER JOIN ((Clients INNER JOIN Reservations_entete " _
    & "ON Clients.ID_Client = Reservations_entete.Id_Client) INNER JOIN " _
    & "((Livres INNER JOIN Reservation_Lignes ON Livres.ID_Livre = Reservation_Lignes.ID_livre) INNER JOIN " _
    & "Remises_Lignes ON Reservation_Lignes.ID_Ligne=Remises_Lignes.ID_Reservation_Ligne) ON " _
    & "Reservations_entete.Id_Reservation = Reservation_Lignes.ID_Reservation) ON " _
    & "(Reservations_entete.Id_Reservation = Remise_Entete.ID_Reservation) AND (Remise_Entete.ID_Remise = " _
    & "Remises_Lignes.ID_Remise) " _
    & "WHERE Reservations_entete.Id_Client=" & clients!ID_Client & " AND Remise_Entete.cloturee=True")

    While Not remise.EOF
     ctl.Nodes.Add "rem" & i, tvwChild, "lrem" & k, "N°" & remise!ID_Remise & " Livre:" & _
     remise!Titre_livre & " Qté:" & remise!Quantite
     remise.MoveNext
     k = k + 1
    Wend
    remise.Close
    If prbar.Value < prbar.Max Then prbar.Value = i
    i = i + 1
    clients.MoveNext
Wend
'On remet la progress bar à 0
prbar.Value = 0
'on ferme le recordset clients
clients.Close
'on ferme la connexion DAO
db.Close
'On active le bouton qui permet de déployer l'arbre
Arbo.Enabled = True
'On lui donne le focus
Arbo.SetFocus
'On désactive le bouton qui crée l'arbre
Afficher.Enabled = False
End Sub