Gestion de favoris sous Access 2007

Option Compare Database

'Déclaration des noms d'images :

Const STRIMAGEHOMME_BLANC = "boy_white.jpg"
Const STRIMAGEHOMME_BLEU = "boy_blue.jpg"
Const STRIMAGEFEMME_BLANC = "girl_white.jpg"
Const STRIMAGEFEMME_BLEU = "girl_blue.jpg"


'Déclaration des attributs de la classe
Private p_intNumClient As Integer
Private p_strNomClient As String
Private p_strPrenomClient As String
Private p_bolSexeClient As Boolean


'Méthode qui permettra d'initialiser l'objet avec les valeurs adéquates
Public Sub Personnaliser(intNumClient As Integer, strNomClient As String, _
    strPrenomClient As String, bolSexeClient As Boolean)
    p_intNumClient = intNumClient
    p_strNomClient = strNomClient
    p_strPrenomClient = strPrenomClient
    p_bolSexeClient = bolSexeClient
End Sub

'Méthode qui retourne le nom formaté du client
Property Get NomComplet() As String
    NomComplet = StrConv(p_strNomClient & " " & p_strPrenomClient, vbProperCase)
End Property

'Méthode qui retourne le chemin de l'image blanche à utiliser
Property Get ImageBlanche() As String
    ImageBlanche = CurrentProject.Path & "\" & IIf(p_bolSexeClient, STRIMAGEHOMME_BLANC, STRIMAGEFEMME_BLANC)
End Property
'Méthode qui retourne le chemin de l'image bleue à utiliser
Property Get ImageBleue() As String
    ImageBleue = CurrentProject.Path & "\" & IIf(p_bolSexeClient, STRIMAGEHOMME_BLEU, STRIMAGEFEMME_BLEU)
End Property
'Méthode qui retourne le numéro du client
Property Get Num() As Integer
    Num = p_intNumClient
End Property
'Méthode qui retourne un identifiant alphanumérique du client
Property Get Cle() As String
    Cle = "cli" & p_intNumClient
End Property

Public Sub ConstructionFavoris()
'Déclarations des variables
Dim oDb As DAO.Database
Dim oRst As DAO.Recordset
Dim oClient As classClient
'Instancie la base de données
Set oDb = CurrentDb
'Ouvre un recordset sur la requête
Set oRst = oDb.QueryDefs(STRREQUETE).OpenRecordset
'Initialise la collection
Set colFavoris = New Collection
With oRst
    'Pour chaque enregistrement, crée un nouvel objet classClient
    'et l'ajoute à la collection
    While Not .EOF
        Set oClient = New classClient
        oClient.Personnaliser .Fields("NumClient").Value, _
                                .Fields("NomClient").Value, _
                                .Fields("PrenomClient").Value, _
                                .Fields("SexeClient").Value
                                
        'Ajoute le client à la collection
        colFavoris.Add oClient, oClient.Cle
    .MoveNext
    Wend
End With
'Ferme les objets et libère la mémoire
oRst.Close
Set oRst = Nothing
Set oDb = Nothing
End Sub

Public Sub AjouterClient(intNumClient As Integer)
'Déclarations des variables
Dim oDb As DAO.Database
Dim oRst As DAO.Recordset
Dim oClient As classClient
'Instancie la base de données
Set oDb = CurrentDb
Set oRst = oDb.QueryDefs(STRREQUETE).OpenRecordset
'Ouvre un recordset sur la requête
With oRst
    'Ajoute le client dans la table
    .AddNew
    .Fields("NumClient").Value = intNumClient
    .Update
    .MoveLast
    'Crée l'objet classClient correspondant
    Set oClient = New classClient
    oClient.Personnaliser .Fields("NumClient").Value, _
                                .Fields("NomClient").Value, _
                                .Fields("PrenomClient").Value, _
                                .Fields("SexeClient").Value

End With

With colFavoris
    'Si la collection contient déjà des clients, alors ajouter au début
    If .count > 0 Then
        .Add oClient, oClient.Cle, .Item(1).Cle
    Else
        .Add oClient, oClient.Cle
    End If
End With
End Sub

Const STRREQUETE = "R01_FAVORIS"
Public colFavoris As Collection

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="getMonRuban"> 
   <ribbon startFromScratch="true">
      <tabs>
        <tab id="tabEvenement" label="Gestion des clients" visible="true">
			<group id="grpfavoris" label="favoris">
			
			<gallery 
				id="galFavoris" 
				label="Mes Favoris" 
				columns="1"  
				getImage="getImageGalleryFavoris" 
				getItemCount="getNBFavoris" 
				getItemLabel="getLabelFavoris" 
				getItemImage="getImageFavoris" 
				getItemID="getIdFavoris" 
				size="large" 
				
			/>
				
			<button 
				id="btnAjout" 
				label="Ajouter aux favoris" 
				size="normal"
				 
			/>
			</group>
        </tab>
      </tabs>
   </ribbon>
</customUI>

Sub getNBFavoris(control As IRibbonControl, ByRef count)
    count = colFavoris.count
End Sub

Sub getLabelFavoris(control As IRibbonControl, index As Integer, ByRef label)
    Dim oClient As classClient
    Set oClient = colFavoris(index + 1)
    label = oClient.NomComplet
End Sub

Sub getIdFavoris(control As IRibbonControl, index As Integer, ByRef ID)
    Dim oClient As classClient
    Set oClient = colFavoris(index + 1)
    ID = oClient.Cle
End Sub

Sub getImageFavoris(control As IRibbonControl, index As Integer, ByRef image)
    Dim oClient As classClient
    Set oClient = colFavoris(index + 1)
    Set image = stdole.LoadPicture(oClient.ImageBlanche)
End Sub

Sub getImageGalleryFavoris(control As IRibbonControl, ByRef image)
    Set image = stdole.LoadPicture(CurrentProject.Path & "\no_blue.jpg")
End Sub

Public Function initRibbon()
Dim strXML As String
Dim oFso As New FileSystemObject
Dim oFtxt As TextStream
ConstructionFavoris
'Charge le fichier XML en mémoire
Set oFtxt = oFso.OpenTextFile(CurrentProject.Path & _
      "\ribbon.xml", ForReading)
'Récupère le contenu
strXML = oFtxt.ReadAll
'Charge le rubban personnalisé correspondant
Application.LoadCustomUI "rubanFavoris", strXML
End Function

Sub getMonRuban(ribbon As IRibbonUI)
Set oMonRuban = ribbon
End Sub

<gallery 
				id="galFavoris" 
				label="Mes Favoris" 
				columns="1"  
				getImage="getImageGalleryFavoris" 
				getItemCount="getNBFavoris" 
				getItemLabel="getLabelFavoris" 
				getItemImage="getImageFavoris" 
				getItemID="getIdFavoris" 
				size="large" 
				onAction="Selectionner"
			/>
				
			<button 
				id="btnAjout" 
				label="Ajouter aux favoris" 
				size="normal"
				onAction="Ajouter"
			/>
			</group>

Public Sub Selectionner(ByVal control As IRibbonControl, _
    selectedId As String, selectedIndex As Integer)
On Error GoTo err
    Dim oClient As classClient
    Dim oFrm As Form
    Dim strFiltre As String
    'Accède au formulaire
    Set oClient = colFavoris(selectedId)
    'Cherche le client correspondant dans le formulaire
    Forms(STRFORMULAIRE).Recordset.FindFirst "NumClient=" & oClient.Num
err:
End Sub

Public Sub Ajouter(ByVal control As IRibbonControl)
    'Appel la procédure AjouterClient
    AjouterClient Forms(STRFORMULAIRE)![NumClient]
End Sub

Sub getLabelGalleryFavoris(control As IRibbonControl, ByRef label)
On Error GoTo err
    Dim oClient As classClient
    Dim oFrm As Form
    'Accède au formulaire
    Set oFrm = Forms(STRFORMULAIRE)
    'Vérifie si le client existe dans les favoris
    Set oClient = colFavoris("cli" & oFrm![NumClient])
    'Si oui, affiche son nom complet
    label = oClient.NomComplet
fin:

Exit Sub

err:
    label = "Mes Favoris"
    Resume fin
End Sub
Sub getImageGalleryFavoris(control As IRibbonControl, ByRef image)
On Error GoTo err
    Dim oClient As classClient
    Dim oFrm As Form
     'Accède au formulaire
    Set oFrm = Forms(STRFORMULAIRE)
     'Vérifie si le client existe dans les favoris
    Set oClient = colFavoris("cli" & oFrm![NumClient])
    'Si oui, affiche son image
    Set image = stdole.LoadPicture(oClient.ImageBleue)
fin:

Exit Sub

err:
    Set image = stdole.LoadPicture(CurrentProject.Path & "\no_blue.jpg")
    Resume fin
End Sub

			<gallery 
				id="galFavoris" 
				getLabel="getLabelGalleryFavoris" 
				columns="1"  
				getImage="getImageGalleryFavoris" 
				getItemCount="getNBFavoris" 
				getItemLabel="getLabelFavoris" 
				getItemImage="getImageFavoris" 
				getItemID="getIdFavoris" 
				size="large" 
				onAction="Selectionner"
			/>

Private Sub Form_Current()
    If Not oMonRuban Is Nothing Then
        oMonRuban.InvalidateControl "galFavoris"
    End If
End Sub